Solved

Hard disk serial number

Posted on 2008-10-21
6
1,883 Views
Last Modified: 2013-12-26
Hi floks,

I want the program in vb 6.0 which reads the hard disk serial number from multiple hard disks present in the machine.

Many thanks

Kamlesh Lalwani
0
Comment
Question by:dotsandcoms
6 Comments
 
LVL 8

Expert Comment

by:MatthiasVance
ID: 22766007
There is sample code provided here, I hope it helps you out:
http://www.dreamincode.net/forums/showtopic16038.htm

Kind regards,

Matthias Vance
0
 
LVL 17

Expert Comment

by:Shanmuga Sundaram
ID: 22866027
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Private Sub Form_Load()
Dim nRet As Long
Dim VolName As String
Dim MaxCompLen As Long
Dim VolFlags As Long
Dim VolFileSys As String

VolName = Space$(256)
VolFileSys = Space$(256)

nRet = GetVolumeInformation("C:\", VolName, Len(VolName), lngVolumeID, MaxCompLen, VolFlags, VolFileSys, Len(VolFileSys))
MsgBox lngVolumeID ' Serial Number
nRet = GetVolumeInformation("D:\", VolName, Len(VolName), lngVolumeID, MaxCompLen, VolFlags, VolFileSys, Len(VolFileSys))
MsgBox lngVolumeID ' Serial Number
End Sub
0
 
LVL 8

Expert Comment

by:MatthiasVance
ID: 22867249
GetVolumeInformation:
"This function returns the volume serial number that the operating system assigns when a hard disk is formatted. To programmatically obtain the hard disk's serial number that the manufacturer assigns, use the Windows Management Instrumentation (WMI) Win32_PhysicalMedia property SerialNumber."

I wasn't sure whether you needed the first or second solution.

Kind regards,

Matthias Vance
0
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
LVL 26

Expert Comment

by:EDDYKT
ID: 22877882


Private Sub Command1_Click()
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk", , 48)
For Each objItem In colItems
    Debug.Print "Access: " & objItem.Access
    Debug.Print "Availability: " & objItem.Availability
    Debug.Print "BlockSize: " & objItem.BlockSize
    Debug.Print "Caption: " & objItem.Caption
    Debug.Print "Compressed: " & objItem.Compressed
    Debug.Print "ConfigManagerErrorCode: " & objItem.ConfigManagerErrorCode
    Debug.Print "ConfigManagerUserConfig: " & objItem.ConfigManagerUserConfig
    Debug.Print "CreationClassName: " & objItem.CreationClassName
    Debug.Print "Description: " & objItem.Description
    Debug.Print "DeviceID: " & objItem.DeviceID
    Debug.Print "DriveType: " & objItem.DriveType
    Debug.Print "ErrorCleared: " & objItem.ErrorCleared
    Debug.Print "ErrorDescription: " & objItem.ErrorDescription
    Debug.Print "ErrorMethodology: " & objItem.ErrorMethodology
    Debug.Print "FileSystem: " & objItem.FileSystem
    Debug.Print "FreeSpace: " & objItem.FreeSpace
    Debug.Print "InstallDate: " & objItem.InstallDate
    Debug.Print "LastErrorCode: " & objItem.LastErrorCode
    Debug.Print "MaximumComponentLength: " & objItem.MaximumComponentLength
    Debug.Print "MediaType: " & objItem.MediaType
    Debug.Print "Name: " & objItem.Name
    Debug.Print "NumberOfBlocks: " & objItem.NumberOfBlocks
    Debug.Print "PNPDeviceID: " & objItem.PNPDeviceID
    Debug.Print "PowerManagementCapabilities: " & objItem.PowerManagementCapabilities
    Debug.Print "PowerManagementSupported: " & objItem.PowerManagementSupported
    Debug.Print "ProviderName: " & objItem.ProviderName
    Debug.Print "Purpose: " & objItem.Purpose
    Debug.Print "Size: " & objItem.Size
    Debug.Print "Status: " & objItem.Status
    Debug.Print "StatusInfo: " & objItem.StatusInfo
    Debug.Print "SupportsFileBasedCompression: " & objItem.SupportsFileBasedCompression
    Debug.Print "SystemCreationClassName: " & objItem.SystemCreationClassName
    Debug.Print "SystemName: " & objItem.SystemName
    Debug.Print "VolumeName: " & objItem.VolumeName
    Debug.Print "VolumeSerialNumber: " & objItem.VolumeSerialNumber
Next


End Sub
0
 
LVL 17

Expert Comment

by:Shanmuga Sundaram
ID: 22878025
I have modified EDDYKT code. Since dotsandcoms needs vb 6.0 which reads the hard disk serial number from multiple hard disks present in the machine, I have altered the code to store the drive caption and its serial number in a file and open it.

Private Sub Command1_Click()
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk", , 48)
Open "C:\ss.txt" For Output As #1
For Each objItem In colItems
    Print #1, "VolumeName: " & objItem.Caption & " Drive"
    Print #1, "VolumeSerialNumber: " & objItem.VolumeSerialNumber
Next
Close #1
Shell "notepad C:\ss.txt", vbMaximizedFocus
End Sub
0
 

Accepted Solution

by:
dotsandcoms earned 0 total points
ID: 22957193
I found the solutions myself by using following code :

Private Sub Combo1_Click()

   Dim drv_info As DRIVE_INFO

   Dim sInfo As String

   Dim sInfoAttr As String

   drv_info = GetDriveInfo(Combo1.ListIndex)

   sInfo = Combo1.List(Combo1.ListIndex)

   sInfo = sInfo & ": " & vbCrLf

   Text1 = ""

   With drv_info

       If .bDriveType = 0 Then sInfo = sInfo & "[Not present]"

       If .bDriveType = 2 Then sInfo = sInfo & "[ATAPI drive - info not available]"

       If .bDriveType = 1 Then

          sInfo = sInfo & "[IDE drive]" & vbCrLf

          sInfo = sInfo & "Model: " & Trim(.Model) & vbCrLf

          sInfo = sInfo & "FirmWare: " & Trim(.FirmWare) & vbCrLf

          sInfo = sInfo & "SerialNumber: " & Trim(.SerialNumber) & vbCrLf

          newid = Trim(.SerialNumber)

          sInfo = sInfo & "Cilinders: " & .Cilinders & vbCrLf

          sInfo = sInfo & "Heads: " & .Heads & vbCrLf

          sInfo = sInfo & "SecPerTrack: " & .SecPerTrack & vbCrLf

          sInfoAttr = Format("Attribute Name", String(24, "@") & "!") & Format("Value", String(7, "@") & "!") & Format("Threshold", String(11, "@") & "!") & Format("WorstValue", String(12, "@") & "!") & "Status" & vbCrLf

          sInfoAttr = sInfoAttr & String(60, "-") & vbCrLf

          For i = 1 To .NumAttributes - 1

              sInfoAttr = sInfoAttr & Format(.Attributes(i).AttrName, String(25, "@") & "!") & Format(.Attributes(i).AttrValue, String(3, "@")) & vbTab & Space(2) & Format(.Attributes(i).ThresholdValue, String(3, "@")) & vbTab & Format(.Attributes(i).WorstValue, String(8, "@")) & vbTab & Format("&H" & Hex(.Attributes(i).StatusFlags), String(4, "@"))

'              If (.Attributes(i).StatusFlags And 1) = 1 Then sInfoAttr = sInfoAttr & " (bad health)"

              sInfoAttr = sInfoAttr & vbNewLine

          Next i

          Text1 = sInfoAttr

       End If

   End With

   Label1 = sInfo

End Sub

Open in new window

0

Featured Post

New! My Passport Wireless Pro Wi-Fi Mobile Storage

Portable wireless storage to offload, edit, and stream anywhere.

High-capacity, wireless mobile storage designed to accompany professional photographers and videographers in the field to easily offload, edit and stream captured photos and high-definition videos.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The Samsung SSD 840 EVO and 840 EVO mSATA have a well-known problem with a drop in read performance. I first learned about this in an interesting thread here at Experts Exchange: http://www.experts-exchange.com/Hardware/Storage/Hard_Drives/Q_2852…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

27 Experts available now in Live!

Get 1:1 Help Now