Jump to content

Recommended Posts


Posted

Great, GunSmokingMan! :thumbup Thanks!

However, it'd be nice if it was not restricted to >= Vista, since cluberti's original script runs perfectly on XP SP3...

Would you please relax that restriction?

Posted

Cluberti code, is what I am using

objOSItem.BuildNumber => 6000
Arch = objOSItem.OSArchitecture

The reason for XP Block

OSArchitecture
Data type: string
Access type: Read-only

Architecture of the operating system, as opposed to the processor.

Example: 32-bit

Windows Server 2003, Windows 2000, Windows NT 4.0, Windows XP, and Windows Me/98/95: This property is not available.

I will write one that will work in therory on XP and up.

Posted

A couple points (ignoring the coding style/conventions and other similar things):

-you're not using the old ghetto VB versions anymore, so you can let go of the old stuff like vbCrLf and use the new ways like Environment.NewLine()

-loads of things could be written in other ways like String("-",107) instead of typing 107 dashes to make a line...

-for WMI, you'd want to be using the built-in System.Management namespace, and not using COM interop with a scripting object... I'm not saying you should PInvoke everything (might as well use C++/CLI then) but this is the other extreme

-many things are better done otherwise (you're not using vbscript here, you have some options), like for example resolving the CultureInfo from a LCID (e.g. 1033 to English, USA) you should use the methods in the System.Globalization namespace instead of a 6000 line select case e.g. for a C# console app you'd do something like this:

CultureInfo ci = new CultureInfo(1033);
Console.Write("Locale for LCID {0} is {1}\r\n", ci.LCID, ci.NativeName);

(not forgetting to add "using System.Globalization;" at the top); the output would be: "Locale for LCID 1033 is English (United States)"

There are also a million other ways to check for a x64 platform instead of OSArchitecture (e.g. PInvoke GetNativeSystemInfo, or IsWow64Process assuming a 32bit exe), but the fastest/easiest thing is checking the value of IntPtr.Size (4 for x86, 8 for x64 - assuming you platform is set to "any cpu" under the build tab of your project's properties) or perhaps checking the PROCESSOR_ARCHITECTURE environment variable (see if it's "AMD64" or "x86")

That being said, there would be reasons to have a version that works only on newer OS'es e.g. the NumberOfLogicalProcessors property of the Win32_ComputerSystem class and the NumberOfCores and NumberOfLogicalProcessors properties of the Win32_Processor class.

cluberti's vbscript was just fine (arguably better*) as-is :P There's likely over a dozen such apps on codeproject.com too (I'm not the reinventing-the-wheel kind) 95% of what I'd like to have in such an app can't be gathered from WMI either (loads of it would require reading from the SMBus directly which is quite a pain under Windows, one would have to write their own lm-sensors like lib first, including support for each particular chip used on any board/chipset... which is plain impossible for a single guy)

* As in, it had no requirement for the .NET framework, it didn't need to be compiled, was easier to edit/modify, etc. Your code doesn't improve it in any way, nor does it even make any actual use of the features of the language & framework you've used. Like they say, you can write fortran in any language -- but here it's more like you can write vbscript in any language...

Posted
I will write one that will work in therory on XP and up.

I find that OS ID code is definitely tough, simply for the number of variations to check for and the inability (by yourself) to see whether you got it working right or not. For the time I tried it, I found the code for Vista and above to be much easier than the code for anything else.

Speaking of which (if I remember what I did right), you might as well go for "all windows", since about 90% of the checks are for Windows versions that are >= 5.00

Posted

You forget that some of the logic in the script is Vista+, hence why my script checked build #s. XP, 2003, and 2000 don't have a lot of good reporting data you can call via WMI, whereas Vista+ does. Hence the script limitations - they're actually easier to work around in vbs than .NET, too, because in this specific instance, .net is much more inflexible and requires a lot more lines of code to emulate things that can be easily hacked together in a VBS. I'll maybe take a look at this when I get some time and see if I can get some things working, but don't hold your breath :).

Posted (edited)
XP, 2003, and 2000 don't have a lot of good reporting data you can call via WMI, whereas Vista+ does.

Vista is nice in the sense that even if you go standard API (and not WMI), that all it takes is one call to get all you need. Unfortunately that's not the case with XP/2003/2000 and below.

To that point, I ended up splitting my code when I did it. That was because it took so many calls and tests, which was indicated in my research. I'm sure it could be simplified a lot, but the key is first to get it correct. Unfortunately, Windows wasn't very standardized, so it's hard to tell that. Unless you have access to all of them.

Given that, I should go ahead and ask if people would test and see if I'm right or wrong on my code. I tested it against Windows XP Home, Windows XP Professional, Windows ME, and all the compatibility modes in XP (which return the proper OSes). There are two execs in this ZIP, Winmain and prodmain (both command-line). Winmain is a generic version id code, Prodmain is a SKU specific one ("Windows XP Professional" instead of simply "Windows XP"), and also tests my 32-bit/64-bit OS detection code. Hopefully, they are right, but if not, hopefully they can be corrected and I can post the source (I hate to post something I haven't fully tested).

NOTE: What I posted doesn't work on Vista or above

Edited by Glenn9999
  • 2 weeks later...
Posted

I have updated the code so it should be able to retrieve these keys Office 2010, Office 2007, Office 2003, Office XP

Imports System
Imports System.IO
Public Class Form1
Const GB = 1073741824
Const MB = 1048576
'-> VBS Objects
Dim Act = Microsoft.VisualBasic.CreateObject("Wscript.Shell")
Dim Tme = Microsoft.VisualBasic.CreateObject("WbemScripting.SWbemDateTime")
Dim Wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2")
'-> Output Varibles
Dim Lne = "-----------------------------------------------------------------------------------------------------------"
Dim vB = vbCrLf
Dim vT = vbTab
Dim ARW = Chr(160) & Chr(187) & Chr(160)
'-> Varibles To Center Form
Dim LBody As Integer = Me.Width.ToString
Dim LSide As Integer = My.Computer.Screen.WorkingArea.Width.ToString / 2
''' <summary>
''' Form Onload Attempt To Center Horizontally
''' </summary>
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
LSide = LSide - LBody
Me.Left = LSide
Me.Top = 75
End Sub
''' <summary>
''' Button1 Click Actions, Scan Computer, Save Results, Scan Computer
''' </summary>
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Select Case Button1.Text
Case "Scan Computer"
Button1.Text = "Processing"
Scan_Computer()
TextBox1.ScrollBars = ScrollBars.Both
Button1.Text = "Save Results"
Case "Save Results"
Save_Results()
Button1.Text = "Clear Info"
Case "Clear Info"
Clear_Info()
TextBox1.ScrollBars = ScrollBars.None
Button1.Text = "Scan Computer"
End Select
End Sub
''' <summary>
''' Start The Scan Of The Computer
''' </summary>
Private Sub Scan_Computer()
Dim ScanDate = _
MonthName(Month(Now)) & ", " & _
WeekdayName(Weekday(Now)) & " " & _
Microsoft.VisualBasic.Day(Now) & " " & _
Microsoft.VisualBasic.Year(Now)
Dim ScanTime = Split(Now, " ")
'-> Querry Wmi Classes
Win32_OperatingSystem()
Win32_LogicalDisk()
ListMSKeys()
Win32_Processor()
Win32_VideoController()
Win32_SoundDevice()
Win32_NetworkAdapterConfiguration()
Win32_ComputerSystemProduct()
'-> Display Results In TextBox1
TextBox1.Text = _
vB & Lne & vB & _
" Scan Date " & ARW & ScanDate & vB & _
" Scan Time " & ARW & ScanTime(1) & " " & ScanTime(2) & _
vB & Lne & vB & _
vT & "System Details" & _
vB & Lne & vB & _
OperatingSystem & _
Lne & vB & _
vT & "Microsoft Keys" & vB & _
Lne & vB & _
ProductKeys & _
Lne & vB & _
vT & "Total Amount Of Ram" & vB & _
Lne & vB & _
" Physical Memory " & ARW & RamSize & vB & _
Lne & vB & _
vT & "Processor Details" & vB & _
Lne & vB & _
CpuInfo & _
Lne & vB & _
vT & "Video Card Details" & vB & _
Lne & vB & _
VidCardInfo & _
Lne & vB & _
vT & "Sound Device Information" & vB & _
Lne & vB & _
SoundReport & _
vT & "Logical Disk Information" & vB & _
Lne & vB & _
DiskReport & _
NwaInfo & _
ComputerSystemProduct
End Sub
''' <summary>
''' Save The Scan Of The Computer
''' </summary>
Private Sub Save_Results()
If Not TextBox1.Text = "" Then
Dim Desktop = Act.SpecialFolders("Desktop")
Dim Txt = Desktop & "\" & CSName & "_BasicInfo.txt"
Dim sw As StreamWriter = New StreamWriter(Txt.ToString)
sw.Write(TextBox1.Text)
sw.Close()
Act.Run(Chr(34) & Txt.ToString & Chr(34), 1, True)
Dim A1
A1 = MsgBox("Did You Want To Keep This File", 4132, "Yes To Keep Or No To Delete")
If A1 = 7 Then My.Computer.FileSystem.DeleteFile(Txt.ToString)
End If
End Sub
''' <summary>
''' Save The Scan Of The Computer
''' </summary>
Private Sub Clear_Info()
BuildChk = "" : ComputerSystemProduct = "" : CpuInfo = "" : CSName = "" : CurrentTimeZone = ""
DaylightInEffect = "" : DiskReport = "" : GetLocal = "" : GetSku = "" : Locale = ""
NumberOfCpu = "" : NwAdapterInfo = "" : NwaInfo = "" : OperatingSystem = ""
ProductKeys = "" : RamSize = "" : Sku = "" : TimeZone = "" : VidCardInfo = ""
TextBox1.Text = ""
End Sub
''' <summary>
''' Querry The Win32_OperatingSystem Class
''' </summary>
Dim BuildChk, CSName, OperatingSystem
Private Sub Win32_OperatingSystem()
Dim Caption
For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem")
CSName = Obj.CSName
If Obj.BuildNumber >= 6000 Then
BuildChk = True
Caption = Obj.Caption & Obj.OSArchitecture
Else
BuildChk = False
Caption = Obj.Caption
End If
'-> SKU
GetSku = Obj.OperatingSystemSKU
Get_SKU()
'-> Service Pack
Dim Sp
If Obj.ServicePackMajorVersion = 0 Then
Sp = "No Service Pack Installed"
Else
Sp = Obj.ServicePackMajorVersion & " " & Obj.ServicePackMinorVersion
End If
'-> Locale
GetLocal = Obj.Locale
Get_Local()
'-> TimeZone
Win32_TimeZone()
'-> CurrentTimeZone, DaylightInEffect, RamSize
Win32_ComputerSystem()
'-> Install Date
Tme.Value = Obj.InstallDate
Dim T1 = Tme.GetVarDate
Dim T2 = Split(Tme.GetVarDate, " ")
Dim T3 = MonthName(Tme.Month) & ", " & WeekdayName(Weekday(T1)) & " " & Tme.Day & " " & Tme.Year
Dim T4 = T2(1) & " " & T2(2)
'-> Last Boot Up
Tme.Value = Obj.LastBootUpTime
Dim L1 = Tme.GetVarDate
Dim L2 = Split(Tme.GetVarDate, " ")
Dim L3 = MonthName(Tme.Month) & ", " & WeekdayName(Weekday(L1)) & " " & Tme.Day & " " & Tme.Year
Dim L4 = L2(1) & " " & L2(2)
OperatingSystem = _
" Computer Name " & ARW & Obj.CSName & vB & _
" Operating System " & ARW & Caption & vB & _
" Os Version " & ARW & Obj.Version & " " & Sku & " " & Obj.CSDVersion & vB & _
" Service Pack Version " & ARW & Sp & vB & _
" Build Number " & ARW & Obj.BuildNumber & vB & _
" Build Type " & ARW & Obj.BuildType & vB & _
" Serial Number " & ARW & Obj.SerialNumber & vB & _
" Locale " & ARW & Locale & vB & _
" OS Time Zone " & ARW & TimeZone & vB & _
" Offset from UTC " & ARW & CurrentTimeZone & vB & _
" DST In Effect " & ARW & DaylightInEffect & vB & _
Lne & vB & _
" Installed Date " & ARW & T3 & vB & _
" Installed Time " & ARW & T4 & vB & _
" Last Boot Date " & ARW & L3 & vB & _
" Last Boot Time " & ARW & L4 & vB & _
" System Uptime Hours " & ARW & DateDiff("h", L1, Now) & vB
Next
End Sub
''' <summary>
''' Get The SKU From The Win32_OperatingSystem
''' </summary>
Dim GetSku, Sku
Private Sub Get_SKU()
Select Case GetSku
Case 0 : Sku = "Unknown Windows version"
Case 1 : Sku = "Ultimate Edition"
Case 2 : Sku = "Home Basic Edition"
Case 3 : Sku = "Home Premium Edition"
Case 4 : Sku = "Enterprise Edition"
Case 5 : Sku = "Home Basic N Edition"
Case 6 : Sku = "Business Edition"
Case 7 : Sku = "Standard Server Edition"
Case 8 : Sku = "Datacenter Server Edition"
Case 9 : Sku = "Small Business Server Edition"
Case 10 : Sku = "Enterprise Server Edition"
Case 11 : Sku = "Starter Edition"
Case 12 : Sku = "Datacenter Server Core Edition"
Case 13 : Sku = "Standard Server Core Edition"
Case 14 : Sku = "Enterprise Server Core Edition"
Case 15 : Sku = "Enterprise Server Edition for Itanium-Based Systems"
Case 16 : Sku = "Business N Edition"
Case 17 : Sku = "Web Server Edition"
Case 18 : Sku = "Cluster Server Edition"
Case 19 : Sku = "Home Server Edition"
Case 20 : Sku = "Storage Express Server Edition"
Case 21 : Sku = "Storage Standard Server Edition"
Case 22 : Sku = "Storage Workgroup Server Edition"
Case 23 : Sku = "Storage Enterprise Server Edition"
Case 24 : Sku = "Server For Small Business Edition"
Case 25 : Sku = "Small Business Server Premium Edition"
Case Else : Sku = "Could Not Determine Operating System SKU"
End Select
End Sub
''' <summary>
''' Get The Local From The Win32_OperatingSystem
''' </summary>
Dim GetLocal, Locale
Private Sub Get_Local()
Select Case GetLocal
Case 1 : Locale = "Arabic"
Case 4 : Locale = "Chinese (Simplified)– China"
Case 9 : Locale = "English"
Case 1009 : Locale = "English"
Case 1025 : Locale = "Arabic – Saudi Arabia"
Case 1026 : Locale = "Bulgarian"
Case 1027 : Locale = "Catalan"
Case 1028 : Locale = "Chinese (Traditional) – Taiwan"
Case 1029 : Locale = "Czech"
Case 1030 : Locale = "Danish"
Case 1031 : Locale = "German – Germany"
Case 1032 : Locale = "Greek"
Case 1033 : Locale = "English – United States"
Case 1034 : Locale = "Spanish – Traditional Sort"
Case 1035 : Locale = "Finnish"
Case 1036 : Locale = "French – France"
Case 1037 : Locale = "Hebrew"
Case 1038 : Locale = "Hungarian"
Case 1039 : Locale = "Icelandic"
Case 1040 : Locale = "Italian – Italy"
Case 1041 : Locale = "Japanese"
Case 1042 : Locale = "Korean"
Case 1043 : Locale = "Dutch – Netherlands"
Case 1044 : Locale = "Norwegian – Bokmal"
Case 1045 : Locale = "Polish"
Case 1046 : Locale = "Portuguese – Brazil"
Case 1047 : Locale = "Rhaeto-Romanic"
Case 1048 : Locale = "Romanian"
Case 1049 : Locale = "Russian"
Case 1050 : Locale = "Croatian"
Case 1051 : Locale = "Slovak"
Case 1052 : Locale = "Albanian'"
Case 1053 : Locale = "Swedish"
Case 1054 : Locale = "Thai"
Case 1055 : Locale = "Turkish'"
Case 1056 : Locale = "Urdu"
Case 1057 : Locale = "Indonesian"
Case 1058 : Locale = "Ukrainian"
Case 1059 : Locale = "Belarusian"
Case 1060 : Locale = "Slovenian"
Case 1061 : Locale = "Estonian"
Case 1062 : Locale = "Latvian"
Case 1063 : Locale = "Lithuanian"
Case 1065 : Locale = "Persian"
Case 1066 : Locale = "Vietnamese"
Case 1069 : Locale = "Basque"
Case 1070 : Locale = "Serbian"
Case 1071 : Locale = "Macedonian (F.Y.R.O. Macedonia)"
Case 1072 : Locale = "Sutu"
Case 1073 : Locale = "Tsonga"
Case 1074 : Locale = "Tswana"
Case 1076 : Locale = "Xhosa"
Case 1077 : Locale = "Zulu"
Case 1078 : Locale = "Afrikaans"
Case 1080 : Locale = "Faeroese"
Case 1081 : Locale = "Hindi"
Case 1082 : Locale = "Maltese"
Case 1084 : Locale = "Scottish Gaelic"
Case 1085 : Locale = "Yiddish"
Case 1086 : Locale = "Malay – Malaysia"
Case 2049 : Locale = "Arabic – Iraq"
Case 2052 : Locale = "Chinese (Simplified) – PRC"
Case 2055 : Locale = "German – Switzerland"
Case 2057 : Locale = "English – United Kingdom"
Case 2058 : Locale = "Spanish – Mexico"
Case 2060 : Locale = "French – Belgium"
Case 2064 : Locale = "Italian – Switzerland"
Case 2067 : Locale = "Dutch – Belgium"
Case 2068 : Locale = "Norwegian – Nynorsk"
Case 2070 : Locale = "Portuguese – Portugal"
Case 2072 : Locale = "Romanian – Moldova"
Case 2073 : Locale = "Russian – Moldova"
Case 2074 : Locale = "Serbian – Latin"
Case 2077 : Locale = "Swedish – Finland"
Case 3073 : Locale = "Arabic – Egypt"
Case 3076 : Locale = "Chinese (Traditional) – Hong Kong SAR"
Case 3079 : Locale = "German – Austria"
Case 3081 : Locale = "English – Australia"
Case 3082 : Locale = "Spanish – International Sort"
Case 3084 : Locale = "French – Canada"
Case 3098 : Locale = "Serbian – Cyrillic"
Case 4097 : Locale = "Arabic – Libya"
Case 4100 : Locale = "Chinese (Simplified) – Singapore"
Case 4103 : Locale = "German – Luxembourg"
Case 4105 : Locale = "English – Canada"
Case 4106 : Locale = "Spanish – Guatemala"
Case 4108 : Locale = "French – Switzerland"
Case 5121 : Locale = "Arabic – Algeria"
Case 5127 : Locale = "German – Liechtenstein"
Case 5129 : Locale = "English – New Zealand"
Case 5130 : Locale = "Spanish – Costa Rica"
Case 5132 : Locale = "French – Luxembourg"
Case 6145 : Locale = "Arabic – Morocco"
Case 6153 : Locale = "English – Ireland"
Case 6154 : Locale = "Spanish – Panama"
Case 7169 : Locale = "Arabic – Tunisia"
Case 7177 : Locale = "English – South Africa"
Case 7178 : Locale = "Spanish – Dominican Republic"
Case 8193 : Locale = "Arabic – Oman"
Case 8201 : Locale = "English – Jamaica"
Case 8202 : Locale = "Spanish – Venezuela"
Case 9217 : Locale = "Arabic – Yemen"
Case 9226 : Locale = "Spanish – Colombia"
Case 10241 : Locale = "Arabic – Syria"
Case 10249 : Locale = "English – Belize"
Case 10250 : Locale = "Spanish – Peru"
Case 11265 : Locale = "Arabic – Jordan"
Case 11273 : Locale = "English – Trinidad"
Case 11274 : Locale = "Spanish – Argentina"
Case 12289 : Locale = "Arabic – Lebanon"
Case 12298 : Locale = "Spanish – Ecuador"
Case 13313 : Locale = "Arabic – Kuwait"
Case 13322 : Locale = "Spanish – Chile"
Case 14337 : Locale = "Arabic – U.A.E."
Case 14346 : Locale = "Spanish – Uruguay"
Case 15361 : Locale = "Arabic – Bahrain"
Case 15370 : Locale = "Spanish – Paraguay"
Case 16385 : Locale = "Arabic – Qatar"
Case 16394 : Locale = "Spanish – Bolivia"
Case 17418 : Locale = "Spanish – El Salvador"
Case 18442 : Locale = "Spanish – Honduras"
Case 19466 : Locale = "Spanish – Nicaragua"
Case 20490 : Locale = "Spanish – Puerto Rico"
Case Else : Locale = "Could Not Determine OS Locale"
End Select
End Sub
''' <summary>
''' Querry The Win32_TimeZon Class
''' </summary>
Dim TimeZone
Private Sub Win32_TimeZone()
For Each Col In Wmi.ExecQuery("SELECT * FROM Win32_TimeZone")
TimeZone = Col.StandardName
Next
End Sub
''' <summary>
''' Querry The Win32_ComputerSystem Class
''' </summary>
Dim CurrentTimeZone, DaylightInEffect, RamSize
Private Sub Win32_ComputerSystem()
For Each Col In Wmi.ExecQuery("SELECT * FROM Win32_ComputerSystem")
CurrentTimeZone = Col.CurrentTimeZone / 60 & " Hours"
DaylightInEffect = Col.DaylightInEffect
'-> Total Memory EG Ram Amount
If Col.TotalPhysicalMemory > GB Then
RamSize = FormatNumber(Col.TotalPhysicalMemory / GB, 2) & " GB"
ElseIf Col.CurrentTimeZone < GB Then
RamSize = FormatNumber(Col.TotalPhysicalMemory / MB, 2) & " MB"
End If
If BuildChk = True Then
NumberOfCpu = _
" Number Of Logical CPU " & ARW & Environment.ProcessorCount & vB & _
" Number Of Processor " & ARW & Col.NumberOfProcessors & vB
Else
NumberOfCpu = _
" Number Of Logical CPU " & ARW & Environment.ProcessorCount & vB
End If
Next
End Sub
''' <summary>
''' Varibles For Getting The Keys
''' </summary>
Dim DigProID = "\DigitalProductId"
Dim RegKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\"
''' <summary>
''' Array For The OS And Office Registry Paths
''' MsKeys(0) = Window Product Key
''' MsKeys(1) = Office 2010
''' MsKeys(2) = Office 2007
''' MsKeys(3) = Office 2003
''' MsKeys(4) = Office XP
''' </summary>
Dim MsKeys() As String = { _
" Operating System Key " & ARW & RegKey & "Windows NT\CurrentVersion", _
" Office 14 2010 Key " & ARW & RegKey & "Office\14.0\Registration\{10140000-0011-0000-1000-0000000FF1CE}", _
" Office 12 2007 Key " & ARW & RegKey & "Office\12.0\Registration", _
" Office 11 2003 Key " & ARW & RegKey & "Office\11.0\Registration", _
" Office 10 XP Key " & ARW & RegKey & "Office\10.0\Registration"}
''' <summary>
''' Sub To Sort Threw The Key Array
''' </summary>
Dim ProductKeys
Private Sub ListMSKeys()
For Each K In MsKeys
Dim Z1 = Split(K, ARW)
Dim A1 = Z1(1) & DigProID
Try
GetKey(Act.RegRead(A1))
ProductKeys = ProductKeys & Z1(0) & ARW & GetKey(Act.RegRead(A1)) & vbCrLf
Catch ex As Exception
End Try
Next
End Sub
''' <summary>
''' Get The OS Or Office Key
''' </summary>
Dim Key
Function GetKey(ByVal rpk)
Dim i, j
Dim dwAccumulator = "", KeyOs = ""
Const rpkOffset = 52 : i = 28
Dim szPossibleChars = "BCDFGHJKMPQRTVWXY2346789"
Do
dwAccumulator = 0 : j = 14
Do
dwAccumulator = dwAccumulator * 256
dwAccumulator = rpk(j + rpkOffset) + dwAccumulator
rpk(j + rpkOffset) = (dwAccumulator \ 24) And 255
dwAccumulator = dwAccumulator Mod 24
j = j - 1
Loop While j >= 0
i = i - 1 : KeyOs = Mid(szPossibleChars, dwAccumulator + 1, 1) & KeyOs
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i - 1 : KeyOs = "-" & KeyOs
End If
Loop While i >= 0
GetKey = KeyOs
Key = KeyOs
End Function
''' <summary>
''' Querry The Win32_Processor Class
''' </summary>
Dim CpuInfo, NumberOfCpu
Private Sub Win32_Processor()
Dim CPUArch
For Each Col In Wmi.ExecQuery("SELECT * FROM Win32_Processor")
Select Case Col.Architecture
Case 0 : CPUArch = "x86"
Case 1 : CPUArch = "MIPS"
Case 2 : CPUArch = "Alpha"
Case 3 : CPUArch = "PowerPC"
Case 6 : CPUArch = "Itanium"
Case 9 : CPUArch = "x64"
Case Else : CPUArch = "Could Not Determine CPU Architecture"
End Select
CpuInfo = _
" Processor Caption " & ARW & Col.Caption & vB & _
" CPU Manufacturer By " & ARW & Col.Manufacturer & vB & _
" Processor Name " & ARW & Col.Name & " (" & CPUArch & ")" & vB & _
" CPU Current Speed " & ARW & Col.CurrentClockSpeed & vB & _
NumberOfCpu
Next
End Sub
''' <summary>
''' Querry The Win32_VideoController Class
''' </summary>
Dim VidCardInfo
Private Sub Win32_VideoController()
Dim T1 = "No Information Found!"
For Each Col In Wmi.ExecQuery("SELECT * FROM Win32_VideoController")
Dim V1 = " Video Card Name " & ARW & Col.Name
Dim V2
Try
V2 = " Video Adapter DAC " & ARW & Col.AdapterDACType
Catch ex As Exception
V2 = " Video Adapter DAC " & ARW & T1
End Try
Dim V3 = " Video Adapter PNP ID " & ARW & Col.PNPDeviceID
Dim V4
Try
V4 = " Video Adapter RAM " & ARW & FormatNumber(Col.AdapterRAM / MB, 2) & " MB"
Catch ex As Exception
V4 = " Video Adapter RAM " & ARW & T1
End Try
Dim V5 = " Driver Version " & ARW & Col.DriverVersion
Tme.Value = Col.DriverDate
VidCardInfo = V1 & vB & V2 & vB & V3 & vB & V4 & vB & V5 & vB & _
" Driver Date " & ARW & Tme.GetVarDate & vB
Next
End Sub
''' <summary>
''' Querry The Win32_SoundDevice Class
''' </summary>
Dim SoundReport
Private Sub Win32_SoundDevice()
For Each Col In Wmi.ExecQuery("SELECT * FROM Win32_SoundDevice")
SoundReport = SoundReport & _
" Sound Device Name " & ARW & Col.ProductName & vB & _
" Manufacturer By " & ARW & Col.Manufacturer & vB & _
" Sound Device PNP ID " & ARW & Col.PNPDeviceID & vB & _
Lne & vB
Next
End Sub
''' <summary>
''' Querry The Win32_LogicalDisk Class
''' </summary>
Dim DiskReport
Private Sub Win32_LogicalDisk()
For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_LogicalDisk")
If Obj.DriveType = 3 Then
Dim Sz = "", Fr = "", Us = ""
Dim U1 = Obj.Size - Obj.FreeSpace
'-> Sort The Disk Size Add Zero If Needed
If Obj.Size > GB Then Sz = FormatNumber(Obj.Size / GB, 2) & " GB"
If Obj.Size < GB Then Sz = FormatNumber(Obj.Size / MB, 2) & " MB"
If Len(Sz) = 8 Then Sz = "0" & Sz
If Len(Sz) = 7 Then Sz = "00" & Sz
'-> Sort The Disk Free Add Zero If Needed
If Obj.FreeSpace > GB Then Fr = FormatNumber(Obj.FreeSpace / GB, 2) & " GB"
If Obj.FreeSpace < GB Then Fr = FormatNumber(Obj.FreeSpace / MB, 2) & " MB"
If Len(Fr) = 8 Then Fr = "0" & Fr
If Len(Fr) = 7 Then Fr = "00" & Fr
'-> Sort The Disk Used Add Zero If Needed
If U1 > GB Then Us = FormatNumber(U1 / GB, 2) & " GB"
If U1 < GB Then Us = FormatNumber(U1 / MB, 2) & " MB"
If Len(Us) = 8 Then Us = "0" & Us
If Len(Us) = 7 Then Us = "00" & Us
DiskReport = DiskReport & _
" Drive Letter " & ARW & Obj.Caption & vB & _
" Drive Volume Name " & ARW & Obj.VolumeName & vB & _
" Drive File System " & ARW & Obj.FileSystem & vB & _
" Drive Size " & ARW & Sz & vB & _
" Drive Free " & ARW & Fr & vB & _
" Drive Used " & ARW & Us & vB & _
Lne & vB
End If
Next
End Sub
''' <summary>
''' Querry The Win32_NetworkAdapterConfiguration Class
''' </summary>
Dim NwAdapterInfo, NwaInfo
Public Sub Win32_NetworkAdapterConfiguration()
For Each Col In Wmi.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration")
If Not Microsoft.VisualBasic.IsDBNull(Col.IPAddress) Then
NwAdapterInfo = NwAdapterInfo & _
" Network Adapter " & ARW & Col.Description & vB & _
" MAC Address " & ARW & Col.MACAddress & vB & _
" DHCP Enabled " & ARW & Col.DHCPEnabled & vB & _
" IP Address " & ARW & Join(Col.IPAddress, ",") & vB & _
" Subnet Mask " & ARW & Join(Col.IPSubnet, ",") & vB & _
" Default Gateway " & ARW & Join(Col.DefaultIPGateway, ",") & vB & vB & vB
End If
Next
NwaInfo = vT & "Network Adapter Information" & vB & Lne & vB & Replace(NwAdapterInfo, vB & vB, vB & Lne)
End Sub
''' <summary>
''' Querry The Win32_ComputerSystemProduct Class
''' </summary>
Dim ComputerSystemProduct
Public Sub Win32_ComputerSystemProduct()
Win32_BIOS()
For Each Col In Wmi.ExecQuery("SELECT * FROM Win32_ComputerSystemProduct")
ComputerSystemProduct = ComputerSystemProduct & _
" Computer Type " & ARW & Col.Name & vB & _
" Identifying Number " & ARW & Col.IdentifyingNumber & vB & _
CompBios & vB & _
" Computer UUID " & ARW & Col.UUID & vB & _
" Computer Vendor " & ARW & Col.Vendor & vB & Lne & vB
Next
ComputerSystemProduct = vT & "Computer System Product Information" & vB & Lne & vB & ComputerSystemProduct
End Sub
''' <summary>
''' Querry The Win32_BIOS Class
''' </summary>
Dim CompBios
Private Sub Win32_BIOS()
For Each C In Wmi.ExecQuery("SELECT * FROM Win32_BIOS")
CompBios = " Computer BIOS Version " & ARW & C.SMBIOSBIOSVersion
Next
End Sub
End Class

Source Code V3

OsInfo_V3.exe

Posted

It's not OK in XP SP3, just yet, sorry!

It loads. Then I press "Scan Computer" and get, right away, an Unhandled exception...

It says: Public member 'OperatingSystemSKU' on type 'SWbemObjectEx' not found.

cluberti's OSInfo.vbs (if run with cscript) runs OK, though. So it may be simple...

But if it proves not to be, then I suggest using the older, but trusty, GetVersionEx(), instead, at least to see where is it going wrong.

Posted

This would explain the error

OperatingSystemSKU

Stock Keeping Unit (SKU) number for the operating system.

Windows Server 2003, Windows XP, Windows 2000, and Windows NT 4.0: This property is not available.

On the next version I will do a simple check and have this message if it not supported

Property Not Supported By OS

Posted

Er... cluberti... we have a problem...

osinfonu.vbs(545, 9) SWbemDateTime: Generic failure

in Win XP SP3. All previous versions worked without errors. But I think you've also just hit something unsuported on older OSes. But I'm confident it'll be easy to fix that.

Thanks a lot for the new version! :thumbup

Posted

Runs perfectly fine here in XPSP2 and XPSP3 (it was introduced in XP, so it wouldn't work on a 2K machine, but it should on an XPSP3 box). Also, it says generic failure, not "not supported", which means it tried and failed. Try changing the (false) to (true) at the end and see what happens - false tells the command to interpret the time passed in as UTC rather than local offset, so try it as (true) to force a local offset time to the command instead (it is the only one that is false, the other GetVarDate calls are all passed as local offset time). It's trying to grep the timestamp on your video card driver, and it is possible the date is causing GetVarDate to fail interpreting that as UTC.

Posted

Done. Same error. But, I bet you didn't test it with anything near as ancient as my video card! :D

It's a true MSI MS-8817 V1 nVidia GeForce2 MX400 PRO32S (32 MiB; AGP 4x), made at the turn of the millennium!!!

See the relevant last few lines of the report:

	 Video Card:		NVIDIA GeForce2 MX/MX 400
Adapter DAC: Integrated RAMDAC
PNP Device ID: PCI\VEN_10DE&DEV_0110&SUBSYS_88171462&REV_A1\4&1FEB96E4&0&0008
Video RAM: 32 MB
Driver Version: 6.14.10.4523
C:\WINDOWS\OsInfoNu.VBS(546, 9) SWbemDateTime: Generic failure

I got the driver from Windows Update, so it's the one it thinks best for the card but, this nonetheless, its a:

NVIDIA Compatible Windows 2000 Display driver, Version 45.23
according to the Product Name in the nv4_disp.dll (PE Timestamp: 07/28/2003 10:53:44 PM) Properties Tab...

So it's quite possible the installer simply didn't create at all the value it's trying to grep. :)

You said it wouldn't work in a 2k machine... but I guess a 2k driver also fits the bill, don't you?

It's a bug, all right! You could add some code for it to behave gracefully, in the absence of that value, :yes:

in a nod for way-backward compatibility. :P

Now, seriously, if that value should be in the registry, do tell me where it should be and I'll have pleasure in creating it just for the sake of testing this theory.

Posted

See if that does anything for you - I've added error handling around the check, so it should skip past it if it fails. I don't do any logging or output to screen if it fails, but you could do that if you want. I go for aesthetically pleasing in something like this, so any failure to look up a line item should be dealt with silently in something this simple, in my opinion.

Posted

If your latest version is the one in your 'post but last' then I get this:

     Operating System:     Microsoft Windows XP Professional
Version: 5.1.2600 Service Pack 3

<snip />

Network Adapter: Intel(R) PRO/100 VE Network Connection - Packet Sched
uler Miniport
MAC Address: 00:0C:F1:EC:BF:2E
DHCP Enabled: True
IP Address: 0.0.0.0
Subnet Mask:
C:\Documents and Settings\root\Desktop\OSInfo.vbs(601, 13) Microsoft VBScript ru
ntime error: Invalid use of Null: 'Join'

Any ideas?

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...