How to get hardware Info. using VB6?

[Behrooz]

As a programmer, I need my program to get system information about some hardware IDs like CPU ID and manufavteuring date, as well HDD serial number. (this way the system can be uniquely identified by me.) Any solution?
I need a direct access to these system info., because registry keys are in different location in WINXP or WIN98, etc, and can not be used in all the cases.

Thank you in advance and waiting...

[RobDog888]

HDD serial number is retrieved by using an API.

'Example by Alexey ([email protected])
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
' returns errors for UNC Path
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const NO_ERROR = 0
 
 
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _
        "WNetGetConnectionA" (ByVal lpszLocalName As String, _
        ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
    "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long
Private Function fGetDrives() As String
'Returns all mapped drives
    Dim lngRet As Long
    Dim strDrives As String * 255
    Dim lngTmp As Long
    lngTmp = Len(strDrives)
    lngRet = GetLogicalDriveStrings(lngTmp, strDrives)
    fGetDrives = Left(strDrives, lngRet)
End Function
Private Function fGetUNCPath(strDriveLetter As String) As String
    On Local Error GoTo fGetUNCPath_Err
 
 
    Dim Msg As String, lngReturn As Long
    Dim lpszLocalName As String
    Dim lpszRemoteName As String
    Dim cbRemoteName As Long
    lpszLocalName = strDriveLetter
    lpszRemoteName = String$(255, Chr$(32))
    cbRemoteName = Len(lpszRemoteName)
    lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, _
                                       cbRemoteName)
    Select Case lngReturn
        Case ERROR_BAD_DEVICE
            Msg = "Error: Bad Device"
        Case ERROR_CONNECTION_UNAVAIL
            Msg = "Error: Connection Un-Available"
        Case ERROR_EXTENDED_ERROR
            Msg = "Error: Extended Error"
        Case ERROR_MORE_DATA
               Msg = "Error: More Data"
        Case ERROR_NOT_SUPPORTED
               Msg = "Error: Feature not Supported"
        Case ERROR_NO_NET_OR_BAD_PATH
               Msg = "Error: No Network Available or Bad Path"
 
 
        Case ERROR_NO_NETWORK
 
               Msg = "Error: No Network Available"
        Case ERROR_NOT_CONNECTED
               Msg = "Error: Not Connected"
        Case NO_ERROR
               ' all is successful...
    End Select
    If Len(Msg) Then
        MsgBox Msg, vbInformation
    Else
        fGetUNCPath = Left$(lpszRemoteName, cbRemoteName)
    End If
fGetUNCPath_End:
    Exit Function
fGetUNCPath_Err:
    MsgBox Err.Description, vbInformation
    Resume fGetUNCPath_End
End Function
 
 
Private Function fDriveType(strDriveName As String) As String
    Dim lngRet As Long
    Dim strDrive As String
    lngRet = GetDriveType(strDriveName)
    Select Case lngRet
        Case DRIVE_UNKNOWN 'The drive type cannot be determined.
            strDrive = "Unknown Drive Type"
        Case DRIVE_ABSENT 'The root directory does not exist.
            strDrive = "Drive does not exist"
        Case DRIVE_REMOVABLE 'The drive can be removed from the drive.
            strDrive = "Removable Media"
        Case DRIVE_FIXED 'The disk cannot be removed from the drive.
            strDrive = "Fixed Drive"
        Case DRIVE_REMOTE  'The drive is a remote (network) drive.
            strDrive = "Network Drive"
        Case DRIVE_CDROM 'The drive is a CD-ROM drive.
            strDrive = "CD Rom"
        Case DRIVE_RAMDISK 'The drive is a RAM disk.
            strDrive = "Ram Disk"
    End Select
    fDriveType = strDrive
End Function
 
 
Sub sListAllDrives()
    Dim strAllDrives As String
    Dim strTmp As String
    
    strAllDrives = fGetDrives
    If strAllDrives <> "" Then
        Do
            strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1)
            strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1)
            Select Case fDriveType(strTmp)
                Case "Removable Media":
                    Debug.Print "Removable drive :  " & strTmp
                Case "CD Rom":
                    Debug.Print "   CD Rom drive :  " & strTmp
                Case "Fixed Drive":
                    Debug.Print "    Local drive :  " & strTmp
                Case "Network Drive":
                    Debug.Print "  Network drive :  " & strTmp
                    Debug.Print "       UNC Path :  " & _
                                fGetUNCPath(Left$(strTmp, Len(strTmp) - 1))
            End Select
        Loop While strAllDrives <> ""
    End If
End Sub
 
 
Private Sub Form_Load()
    Debug.Print "All available drives: "
    sListAllDrives
End Sub

[RobDog888]

Processor Info...

Option Explicit
'Add reference to Microsoft WMI Scripting Object Library
'Add one command button (Command1)
'Add one textbox (txtProcessor)
'txtProcessor.MultiLine = True
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
 
Private Sub Command1_Click()
    
    'Processor Information
    Dim oProcessors As Variant
    Dim oProcessor As Variant
 
    Set oProcessors = GetObject("winmgmts:\\" & CompName).InstancesOf("Win32_Processor")
    For Each oProcessor In oProcessors
        txtProcessor.Text = txtProcessor.Text & oProcessor.Caption & vbNewLine
        txtProcessor.Text = txtProcessor.Text & "Speed: " & oProcessor.currentclockspeed & " Mhz" & vbNewLine
    Next
 
End Sub
 
Private Function CompName() As String
    
    Dim strString As String
    
    strString = String(255, Chr$(0))
    GetComputerName strString, 255
    strString = Left$(strString, InStr(1, strString, Chr$(0)))
    strString = Left(strString, (Len(strString) - 1))
    CompName = strString
    
End Function

[Behrooz]

Thanks a lot RobDog888, for the codes. It was very useful.

HDD dirve list returns all logical paratitions, but not a 'hard' property of the HDD. Serial Numebr, electronically printed in a chipset inside HDD is what I am looking for.

Will be very thankful if get such an API code.(As you mentioned it can be achieved using API).


And finally, how can I access to a full reference of those magic codes that can do almost anythng using API? (Or to learn more about API itself, not to get fishes, but to learn fishing! )

Best wishes

[RobDog888]

Check out allapi.net for all the cool api tips, tricks, and definitions.

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()
    'KPD-Team 1998
    'URL: [url]http://www.allapi.net/[/url]
    'E-Mail: [email][email protected][/email]
    Dim Serial As Long, VName As String, FSName As String
    'Create buffers
    VName = String$(255, Chr$(0))
    FSName = String$(255, Chr$(0))
    'Get the volume information
    GetVolumeInformation "C:\", VName, 255, Serial, 0, 0, FSName, 255
    'Strip the extra chr$(0)'s
    VName = Left$(VName, InStr(1, VName, Chr$(0)) - 1)
    FSName = Left$(FSName, InStr(1, FSName, Chr$(0)) - 1)
    MsgBox "The Volume name of C:\ is '" + VName + "', the File system name of C:\ is '" + FSName + "' and the serial number of C:\ is '" + Trim(Str$(Serial)) + "'", vbInformation + vbOKOnly, App.Title
End Sub

Closer?

Let me know if you catch a fish!

[Behrooz]

Dear RobDog888

Do not really want to ask about any problem occurs, but:

You didn't mention any limitation with the CPU_Iinfo code you provided, but it doest not work on systems running win98 os. (Two tests and both failed) Error: "Run-time error '432', file name or class name not found during Automation Operation." Runing inside VB envirunment(Win98), while WMI is checked, returns an error in line: Set oProcessors = GetObject("winmgmts....
In WIN XP everything goes fine anyway.
Is it a os dependant code??


HDD serial number (HDD_SN), on the other hand, returns different serial values for the same hardware (dual boot) running win98 and winxp. The phylosophy of using HDD_SN was to have a stable property for the hardware system. Is HDD_SN also OS dependant, or the program itself has a kind of inability?


I didn't catch a fish, but trapped a bug!

Waiting...

[RobDog888]

For the HD serial number, it will return the serial number of the
hard drive that is assigned to it whenever the drive gets
formatted. So if you have a dual boot system, you will have one
sn for 98 and one sn for xp.

I know what serial number you are talking about because I am
running dual raid mirrors and the raid controller utility software
has a form that you can view the actual manufacturers hd serial
number. Its proprietary to the hd manufacturer. I wish I knew too
how to get THAT serial number.

For the WMI requirements, I'm not sure if the parameter for the
line - ).InstancesOf("Win32_Processor") needs to be different for
98. May be something like "Win_16_Processor" since 98 is not
really a 32 bit os, only simulated 32 bit.

HTH

[Behrooz]

About WMI, I worked around it and found the solution last night. There is a WMI (Windows Managmant Instrumantation) Install program which is called WmiCore.exe and can be download from microsoft.com. I did so and installed the package under win98, and everything works fine!
For WinXP and 2000, the package is installed at time of windows installation. However, win95, win98, win98se (also 2000?) require this package to make them enable Windows Managment ability.

For the -let's say 'Printed-, HD serial number, or other 'hard' properties, if you found a clue, just let me know. This is usefu when you want to bind your programs just to user's PC hardware, so illegal copying would be almost impossible.

Thank you very much once again, for all your help and support.

Will be glad to hear from you at [email protected]

[RobDog888]

I am running Win2k sp4 and I have the WMI functionality.
I think the ability to get the hd serial number would be
dependant upon the hd manufacturer. I remember when I had a
bad power chip on an old Western Digital hd, they had there own
dos based utility to diagnose the drive and return any error
codes along with the serial number, etc. I had another diagnostic
utility for Maxtor drives which did the same thing and either one
would not work on the other. Maybe there are some dos
commands or ??? that are universal in returning the serial
number. Possibly some assmebly code that will do it. I just
remembered that I have a Utilities Assembly book that may have
some examples. When I get home I will put it in my car to make
sure I bring it to work tomorrow.

:mike:

[Behrooz]

I found a similar topic here.[URL=http://www.vbforums.com/showthread.php?s=&threadid=234404]

There u'll find a code that returns hd serial (not Volume Serial). The problem is that the code is for vb.net. Is there a way to change it to be run under vb6 ent.?

[RobDog888]

Looks like it has its limitations too. Only will work under XP.
In case anyone wants to see the .Net code.

Dim mgmclass As New System.Management.ManagementClass("Win32_PhysicalMedia")
Dim mgmcoll As Management.ManagementObjectCollection = mgmclass.GetInstances()
Dim mgmenum As Management.ManagementObjectCollection.ManagementObjectEnumerator = mgmcoll.GetEnumerator
mgmenum.MoveNext()
MessageBox.Show(mgmenum.Current.Properties("SerialNumber").Value.ToString)