|
-
Aug 30th, 2000, 01:10 AM
#1
Thread Starter
Hyperactive Member
I am looking for a way that I can get the following list of information from my VB.
Hardware List, like memory, interface card, harddisk, monitor etc
Software List, like those we see in control panel, add/remove
any hint (even only solve part of it) will be much grateful.
Thanks
-
Aug 30th, 2000, 03:25 AM
#2
Guru
Hardware list!
Create a ListBox called lstHardware. (Make it Sorted if you want to)
Also, create a CommandButton called cmdGetHardware.
Code:
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_FILE_NOT_FOUND = 2&
Function StripNulls(ByVal sString As String) As String
Dim lPos As Long
lPos = InStr(sString, vbNullChar)
If lPos = 0 Then StripNulls = sString Else StripNulls = Left(sString, lPos - 1)
End Function
Function InLst(ctlListBox As ListBox, ByVal sItem As String) As Boolean
Dim I As Integer
For I = 0 To ctlListBox.ListCount - 1
If ctlListBox.List(I) = sItem Then
InLst = True
Exit Function
End If
Next
End Function
Sub AddHardware(ctlListBox As ListBox, Optional ByVal sCategory As String = vbNullString)
Dim hKey As Long, dwIndex As Long, sBuffer As String, lBufLen As Long, lRet As Long
If Not RegOpenKey(HKEY_LOCAL_MACHINE, "Enum" & sCategory, hKey) = ERROR_SUCCESS Then
Call MsgBox("Error: Cannot open registry key!", vbCritical)
Exit Sub
End If
lRet = RegQueryValueEx(hKey, "DeviceDesc", 0, ByVal 0, ByVal 0, lBufLen)
If Not ((lRet = ERROR_SUCCESS) Or (lRet = ERROR_FILE_NOT_FOUND)) Then
Call MsgBox("Error: Cannot read from registry!", vbCritical)
Call RegCloseKey(hKey)
Exit Sub
End If
If lRet = ERROR_SUCCESS Then
sBuffer = String(lBufLen, vbNullChar)
lRet = RegQueryValueEx(hKey, "DeviceDesc", 0, ByVal 0, ByVal sBuffer, lBufLen)
If Not ((lRet = ERROR_SUCCESS) Or (lRet = ERROR_FILE_NOT_FOUND)) Then
Call MsgBox("Error: Cannot read from registry!", vbCritical)
Call RegCloseKey(hKey)
Exit Sub
End If
sBuffer = StripNulls(sBuffer)
If (lRet = ERROR_SUCCESS) And Not (InLst(ctlListBox, sBuffer)) Then Call ctlListBox.AddItem(sBuffer)
End If
Do
sBuffer = String(256, vbNullChar)
lRet = RegEnumKey(hKey, dwIndex, sBuffer, 255)
If lRet = ERROR_NO_MORE_ITEMS Then Exit Do
If Not (lRet = ERROR_SUCCESS) Then
Call MsgBox("Error: Cannot read from registry key!", vbCritical)
Call RegCloseKey(hKey)
Exit Sub
End If
Call AddHardware(ctlListBox, sCategory & "\" & StripNulls(sBuffer))
dwIndex = dwIndex + 1
Loop
Call RegCloseKey(hKey)
End Sub
Private Sub cmdGetHardware_Click()
Call lstHardware.Clear
Call LockWindowUpdate(lstHardware.hWnd)
Call AddHardware(lstHardware)
Call LockWindowUpdate(0)
End Sub
Enjoy!
-
Aug 30th, 2000, 03:29 AM
#3
Guru
Software list!
Create a ListBox called lstSoftware. (Make it Sorted if you want to)
Also, create a CommandButton called cmdGetSoftware.
Code:
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_FILE_NOT_FOUND = 2&
Function StripNulls(ByVal sString As String) As String
Dim lPos As Long
lPos = InStr(sString, vbNullChar)
If lPos = 0 Then StripNulls = sString Else StripNulls = Left(sString, lPos - 1)
End Function
Function GetSoftwareName(ByVal sRegistryName As String) As String
Dim hKey As Long, sBuffer As String, lBufLen As Long, lRet As Long
If Not RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Uninstall\" & sRegistryName, hKey) = ERROR_SUCCESS Then
Call MsgBox("Error: Cannot open registry key!", vbCritical)
Exit Function
End If
lRet = RegQueryValueEx(hKey, "DisplayName", 0, ByVal 0, ByVal 0, lBufLen)
If Not ((lRet = ERROR_SUCCESS) Or (lRet = ERROR_FILE_NOT_FOUND)) Then
Call MsgBox("Error: Cannot read from registry!", vbCritical)
Call RegCloseKey(hKey)
Exit Function
End If
If lRet = ERROR_SUCCESS Then
sBuffer = String(lBufLen, vbNullChar)
lRet = RegQueryValueEx(hKey, "DisplayName", 0, ByVal 0, ByVal sBuffer, lBufLen)
If Not ((lRet = ERROR_SUCCESS) Or (lRet = ERROR_FILE_NOT_FOUND)) Then
Call MsgBox("Error: Cannot read from registry!", vbCritical)
Call RegCloseKey(hKey)
Exit Function
End If
If lRet = ERROR_SUCCESS Then GetSoftwareName = StripNulls(sBuffer)
End If
Call RegCloseKey(hKey)
End Function
Sub AddSoftware(ctlListBox As ListBox)
Dim hKey As Long, dwIndex As Long, sBuffer As String, lRet As Long
If Not RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Uninstall", hKey) = ERROR_SUCCESS Then
Call MsgBox("Error: Cannot open registry key!", vbCritical)
Exit Sub
End If
Do
sBuffer = String(256, vbNullChar)
lRet = RegEnumKey(hKey, dwIndex, sBuffer, 255)
If lRet = ERROR_NO_MORE_ITEMS Then Exit Do
If Not (lRet = ERROR_SUCCESS) Then
Call MsgBox("Error: Cannot read from registry key!", vbCritical)
Call RegCloseKey(hKey)
Exit Sub
End If
sBuffer = GetSoftwareName(StripNulls(sBuffer))
If Not sBuffer = vbNullString Then Call ctlListBox.AddItem(sBuffer)
dwIndex = dwIndex + 1
Loop
Call RegCloseKey(hKey)
End Sub
Private Sub cmdGetSoftware_Click()
Call lstSoftware.Clear
Call LockWindowUpdate(lstSoftware.hWnd)
Call AddSoftware(lstSoftware)
Call LockWindowUpdate(0)
End Sub
Enjoy! 
P.S.
You may have noticed that the previous post looks very much like this one.
About this I will say: SO WHAT?
-
Aug 30th, 2000, 03:50 AM
#4
Thread Starter
Hyperactive Member
THANKS......THANKS.....THANKS Very Much.
-
Aug 30th, 2000, 03:55 AM
#5
Thread Starter
Hyperactive Member
Yonatan, more....
Could you tell me how to:
1) Know how much memory is in the machine?
2) How many harddisk is there?
3) The serial of each hard disk?
4) How can I know the hardware is really in the PC now?
Besides, if the user installed say, a hard disk, and then remove later. What will be the impact in the list?
Before hand, thank you very much for your help.
-
Aug 30th, 2000, 05:18 AM
#6
Guru
Question 1!
1) Know how much memory is in the machine?
I am assuming you mean RAM.
Here it is:
Create a Label called lblMemory (set its AutoSize property to True).
Also, create a CommandButton called cmdGetMemory.
Code:
Option Explicit
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Declare Function StrFormatByteSize Lib "shlwapi" Alias "StrFormatByteSizeA" (ByVal dwBytes As Long, ByVal lpszBuffer As String, ByVal cbBufferLen As Long) As String
Function FormatBytes(ByVal lBytes As Long) As String
Dim lPos As Long
FormatBytes = String(256, vbNullChar)
Call StrFormatByteSize(lBytes, FormatBytes, 255)
lPos = InStr(FormatBytes, vbNullChar)
If lPos > 0 Then FormatBytes = Left(FormatBytes, lPos - 1)
End Function
Private Sub cmdGetMemory_Click()
Dim tMS As MEMORYSTATUS
With tMS
Call GlobalMemoryStatus(tMS)
lblMemory.Caption = "You have " & FormatBytes(.dwAvailPhys) & " RAM free, out" & vbNewLine _
& "of " & FormatBytes(.dwTotalPhys) & " RAM (" & Int(.dwAvailPhys / .dwTotalPhys * 100) & "%)"
End With
End Sub
Enjoy!
-
Aug 30th, 2000, 05:23 AM
#7
Guru
Questions 2 and 3!
2) How many harddisk is there?
3) The serial of each hard disk?
Create two Labels, call one of them lblAmount and the other lblSerial (both with their AutoSize set to True).
Also, create a ComboBox called cmbDrives (set its Style property to 2 - Dropdown List).
Code:
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
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 Const DRIVE_FIXED = 3
Function GetSerial(ByVal lSerial As Long) As String
Dim sSerial As String
sSerial = Right("0000000" & Hex(lSerial), 8)
GetSerial = Left(sSerial, 4) & "-" & Right(sSerial, 4)
End Function
Private Sub cmbDrives_Click()
Dim lSerial As Long
Call GetVolumeInformation(cmbDrives.Text, vbNullString, 0, lSerial, ByVal 0, ByVal 0, vbNullString, 0)
lblSerial.Caption = "The serial number for " & cmbDrives.Text & " is " & GetSerial(lSerial)
End Sub
Private Sub Form_Load()
Dim I As Integer
For I = 65 To 90 ' Chr(I) is from "A" to "Z"
If GetDriveType(Chr(I) & ":\") = DRIVE_FIXED Then Call cmbDrives.AddItem(Chr(I) & ":\")
Next
lblAmount.Caption = "There are " & cmbDrives.ListCount & " hard drive partitions!"
End Sub
Enjoy!
-
Aug 30th, 2000, 05:28 AM
#8
-
Sep 3rd, 2000, 09:29 PM
#9
Thread Starter
Hyperactive Member
-
Dec 19th, 2000, 11:06 PM
#10
Thread Starter
Hyperactive Member
Yonatan, HELP....
I use your code in Win98 and it is working fine and good.
But when I run it in Win2K, there is error telling Registry
Key is not found... Can you help?
-
Dec 20th, 2000, 02:18 AM
#11
Guru
I don't know exactly where the error is...
I'm guessing the problem is either reading the list of software or reading the list of hardware, because those are the only codes here that directly read from the registry. 
It could be a problem with the security settings (in a WinNT-based operating system, you have to log on as a user with registry-reading privileges or something like that), or maybe the program has to use some kind of NT token like programs which shut down Windows in NT... It could also be a different registry format in NT. I don't have NT so I can't check.
However, you could tell me more details by following these steps:
- Which one is causing problems? Software list or hardware list?
- In the code that's causing problems (the function AddHardware or the functions AddSoftware, GetSoftwareName or all three if they all don't work), replace all the MsgBoxes:
Code:
' Instead of something like:
Call MsgBox("Error: Cannot read from registry!", vbCritical)
' Use something like:
Call MsgBox("Error: Cannot read from registry! Error code: " & Err.LastDllError, vbCritical)
- Step through, or add breakpoints to the code that's not working, and it will hit one of the MsgBoxes and tell you the error code.
- Post here what's causing the problem (hardware list, software list, or both), the MsgBox you get, where you got it in the code, and what error code came with it, and it would be more fun to help.

-
Dec 21st, 2000, 05:37 PM
#12
Fanatic Member
I would just like to say thanks for the information given in this post as I have been thinking about doing a project involving this info just recently.
-
Jan 10th, 2001, 05:48 AM
#13
Thread Starter
Hyperactive Member
Sorry, Yonatan,
It takes so long to reply since I am out of town for a long vacation and cannot reach my source code.
I set breakpoint and check the error is in the first line
of getting hardware configuration:
If Not RegOpenKey(HKEY_LOCAL_MACHINE, "Enum" & sCategory, hKey) = ERROR_SUCCESS Then
Call MsgBox("Error: Cannot open registry key!", vbCritical)
Exit Sub
End If
Please help!!!
Thanks
-
Jan 10th, 2001, 03:03 PM
#14
Guru
Change this line:
Code:
Call MsgBox("Error: Cannot open registry key!", vbCritical)
To this:
Code:
Call MsgBox("Error: Something sucks! Error code: " & Err.LastDllError, vbCritical)
And then..... Post the error code that it gives you.
-
Jan 10th, 2001, 11:13 PM
#15
Thread Starter
Hyperactive Member
The error code is 0
if I add the statement:
op = RegOpenKey(HKEY_LOCAL_MACHINE, "Enum" & sCategory, hKey)
then the result is op=2
and that will cause not op = -3
-
Jan 11th, 2001, 08:01 AM
#16
-
Jan 11th, 2001, 08:50 PM
#17
Thread Starter
Hyperactive Member
Thanks Yonatan,
So, where do you think I can find such information,
I have WinNT, Win2k, Win95, Win98 here
Can you give me some hint (or what I have to purchase)
so that I can find it out?
Thanks
Chong
-
Jan 12th, 2001, 04:23 PM
#18
Guru
When I originally found it, I just browsed the registry (using the RegEdit program which comes with Windows), and did a search on specific things I have in my hardware list (in the Device Manager), and found them in HKLM\Enum.
You can do the same, and if you don't succeed, browse the web and eventually you'll find the information you want.
-
Aug 7th, 2004, 10:08 AM
#19
Hyperactive Member
For those who need to find it on NT system , use
Hardware: HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Enum
Software: HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
Yonatan's code works with just modifying the key.
-
Aug 7th, 2004, 11:39 AM
#20
Its not very accurate for the hardware function. It returns
services also. Like COM+ System Application, DHCP Client, DNS
Client, etc. Correct me if I am wrong, but most services are not
considered a hardware device. Wouldn't a simulation of the
device manager be more accurate along with physical
components like memory modules, etc. Or even a duplication of
the system information - hardware resources be better?
VB/Office Guru™ (AKA: Gangsta Yoda™ ®)
I dont answer coding questions via PM. Please post a thread in the appropriate forum. 
Microsoft MVP 2006-2011
Office Development FAQ (C#, VB.NET, VB 6, VBA)
Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
If a post has helped you then Please Rate it! 
• Reps & Rating Posts • VS.NET on Vista • Multiple .NET Framework Versions • Office Primary Interop Assemblies • VB/Office Guru™ Word SpellChecker™.NET • VB/Office Guru™ Word SpellChecker™ VB6 • VB.NET Attributes Ex. • Outlook Global Address List • API Viewer utility • .NET API Viewer Utility •
System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6 
-
Aug 7th, 2004, 12:51 PM
#21
Hyperactive Member
You can look for Class values and include only the hardware ones;
or, the services can be found in HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services and remove them from list.
However I agree this is not the way I think the hardware enumeration should be done. Unfortunately, I haven't found the trick yet.
-
Aug 7th, 2004, 12:56 PM
#22
Neither have I. There must be a way, since Windows can do it,
show should we.
Edit: cool I am in 66th place with 2738 posts!
VB/Office Guru™ (AKA: Gangsta Yoda™ ®)
I dont answer coding questions via PM. Please post a thread in the appropriate forum. 
Microsoft MVP 2006-2011
Office Development FAQ (C#, VB.NET, VB 6, VBA)
Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
If a post has helped you then Please Rate it! 
• Reps & Rating Posts • VS.NET on Vista • Multiple .NET Framework Versions • Office Primary Interop Assemblies • VB/Office Guru™ Word SpellChecker™.NET • VB/Office Guru™ Word SpellChecker™ VB6 • VB.NET Attributes Ex. • Outlook Global Address List • API Viewer utility • .NET API Viewer Utility •
System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6 
-
Aug 7th, 2004, 01:22 PM
#23
Hyperactive Member
Driver Information in the Registry at
http://msdn.microsoft.com/library/en...asp?frame=true
says:
The Enum tree is reserved for use by operating system components, and its layout is subject to change. Drivers and user-mode Setup components must use system-supplied functions, such as IoGetDeviceProperty and SetupDiGetDeviceRegistryProperty, to extract information from this tree. Drivers and Setup applications must not access the Enum tree directly. You can view the Enum tree directly using the registry editor when debugging drivers.
I could try some SetupAPIs, but all the information on MSDN seems to be quite new (and time to time preliminary) so I still think this is not the traditional way used in Win9x system.
Last edited by Jhd.Honza; Aug 7th, 2004 at 01:37 PM.
-
Aug 7th, 2004, 01:58 PM
#24
Hyperactive Member
Hey, wouldn't excluding the Root and SW "categories" be enough?
VB Code:
(if are yousing Yonatan code, just past
If LCase(sCategory) = "\root" Then Exit Sub
If LCase(sCategory) = "\sw" Then Exit Sub
in the top of AddHardware Sub to try)
-
Aug 7th, 2004, 02:11 PM
#25
Hyperactive Member
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|