Option Explicit
Sub GetOS()
Dim objOS As Object
Dim Msg, Msg1
On Error Resume Next
' Connect to WMI and obtain instances of Win32_OperatingSystem
For Each objOS In GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
Msg = "BootDevice = " & objOS.BootDevice & vbCr
Msg = Msg & "BuildNumber = " & objOS.BuildNumber & vbCr
Msg = Msg & "BuildType = " & objOS.BuildType & vbCr
Msg = Msg & "Caption = " & objOS.Caption & vbCr
Msg = Msg & "CodeSet = " & objOS.CodeSet & vbCr
Msg = Msg & "CountryCode = " & objOS.CountryCode & vbCr
Msg = Msg & "CreationClassName = " & objOS.CreationClassName & vbCr
Msg = Msg & "CSCreationClassName = " & objOS.CSCreationClassName & vbCr
Msg = Msg & "CSDVersion = " & objOS.CSDVersion & vbCr
Msg = Msg & "CSName = " & objOS.CSName & vbCr
Msg = Msg & "CurrentTimeZone = " & objOS.CurrentTimeZone & vbCr
Msg = Msg & "Debug = " & objOS.Debug & vbCr
Msg = Msg & "Description = " & objOS.Description & vbCr
Msg = Msg & "Distributed = " & objOS.Distributed & vbCr
Msg = Msg & "EncryptionLevel = " & objOS.EncryptionLevel & vbCr
Msg = Msg & "ForegroundApplicationBoost = " & objOS.ForegroundApplicationBoost & vbCr
Msg = Msg & "FreePhysicalMemory = " & objOS.FreePhysicalMemory & vbCr
Msg = Msg & "FreeSpaceInPagingFiles = " & objOS.FreeSpaceInPagingFiles & vbCr
Msg = Msg & "FreeVirtualMemory = " & objOS.FreeVirtualMemory & vbCr '// uint64 FreeVirtualMemory;
Msg = Msg & "InstallDate = " & WMIDateStringToDate(objOS.InstallDate) & vbCr '// datetime InstallDate;
Msg = Msg & "LargeSystemCache = " & objOS.LargeSystemCache & vbCr
Msg = Msg & "LastBootUpTime = " & WMIDateStringToDate(objOS.LastBootUpTime) & vbCr '// datetime LastBootUpTime;
Msg = Msg & "LocalDateTime = " & WMIDateStringToDate(objOS.LocalDateTime) & vbCr '// datetime LocalDateTime;
Msg = Msg & "Locale = " & objOS.Locale & vbCr '// string Locale;
Msg = Msg & "Manufacturer = " & objOS.Manufacturer & vbCr '// string Manufacturer;
Msg = Msg & "MaxNumberOfProcesses = " & objOS.MaxNumberOfProcesses & vbCr '// uint32 MaxNumberOfProcesses;
Msg = Msg & "MaxProcessMemorySize = " & objOS.MaxProcessMemorySize & vbCrLf '// uint64 MaxProcessMemorySize;
Msg1 = Msg1 & "Name = " & objOS.Name & vbCrLf '// string Name;
Msg1 = Msg1 & "NumberOfLicensedUsers = " & objOS.NumberOfLicensedUsers & vbCr '// uint32 NumberOfLicensedUsers;
Msg1 = Msg1 & "NumberOfProcesses = " & objOS.numberOfProcesses & vbCr '// uint32 NumberOfProcesses;
Msg1 = Msg1 & "Number of users = " & objOS.NumberOfUsers & vbCr '// uint32 NumberOfUsers;
Msg1 = Msg1 & "Organization = " & objOS.Organization & vbCr '// string Organization;
Msg1 = Msg1 & "OSLanguage = " & strOsLang(objOS.OSLanguage) & vbCr '// uint32 OSLanguage;
Msg1 = Msg1 & "OSProductSuite = " & objOS.OSProductSuite & vbCr '// uint32 OSProductSuite;
Msg1 = Msg1 & "OSType = " & strOsType(objOS.OSType) & vbCrLf '// uint16 OSType;
Msg1 = Msg1 & "OtherTypeDescription = " & objOS.OtherTypeDescription & vbCr '// string OtherTypeDescription;
Msg1 = Msg1 & "PlusProductID = " & objOS.PlusProductID & vbCr '// string PlusProductID;
Msg1 = Msg1 & "PlusVersionNumber = " & objOS.PlusVersionNumber & vbCr '// string PlusVersionNumber;
Msg1 = Msg1 & "Primary operating system= " & objOS.Primary & vbCr '// boolean Primary;
Msg1 = Msg1 & "ProductType = " & objOS.ProductType & vbCr '// uint32 ProductType;
Msg1 = Msg1 & "QuantumLength = " & objOS.QuantumLength & vbCr '// uint8 QuantumLength;
Msg1 = Msg1 & "QuantumType = " & objOS.QuantumType & vbCr '// uint8 QuantumType;
Msg1 = Msg1 & "RegisteredUser = " & objOS.RegisteredUser & vbCr '// string RegisteredUser;
Msg1 = Msg1 & "SerialNumber = " & objOS.SerialNumber & vbCr '// string SerialNumber;
Msg1 = Msg1 & "ServicePackMajorVersion = " & objOS.ServicePackMajorVersion & vbCr '// uint16 ServicePackMajorVersion;
Msg1 = Msg1 & "ServicePackMinorVersion = " & objOS.ServicePackMinorVersion & vbCr '// uint16 ServicePackMinorVersion;
Msg1 = Msg1 & "SizeStoredInPagingFiles = " & objOS.SizeStoredInPagingFiles & vbCr '// uint64 SizeStoredInPagingFiles;
Msg1 = Msg1 & "Status = " & objOS.Status & vbCr '// string Status;
Msg1 = Msg1 & "SuiteMask = " & objOS.SuiteMask & vbCr '// uint32 SuiteMask;
Msg1 = Msg1 & "SystemDevice = " & objOS.SystemDevice & vbCr '// string SystemDevice;
Msg1 = Msg1 & "SystemDirectory = " & objOS.SystemDirectory & vbCr '// string SystemDirectory;
Msg1 = Msg1 & "SystemDrive = " & objOS.SystemDrive & vbCr '// string SystemDrive;
Msg1 = Msg1 & "Operating System = " & objOS.Caption & vbCr '// uint64 TotalSwapSpaceSize;
Msg1 = Msg1 & "TotalVirtualMemorySize = " & objOS.TotalVirtualMemorySize & vbCr '// uint64 TotalVirtualMemorySize;
Msg1 = Msg1 & "TotalVisibleMemorySize = " & objOS.TotalVisibleMemorySize & vbCr '// uint64 TotalVisibleMemorySize;
Msg1 = Msg1 & "Version = " & objOS.Version & vbCr '// string Version;
Msg1 = Msg1 & "WindowsDirectory = " & objOS.WindowsDirectory & vbCr '// string WindowsDirectory;
MsgBox Msg
MsgBox Msg1
Next
If Err <> 0 Then MsgBox Err.Description
End Sub
Private Function WMIDateStringToDate(dtmInstallDate)
WMIDateStringToDate = CDate( _
Mid(dtmInstallDate, 5, 2) & "/" & _
Mid(dtmInstallDate, 7, 2) & "/" & _
Left(dtmInstallDate, 4) & " " & _
Mid(dtmInstallDate, 9, 2) & ":" & _
Mid(dtmInstallDate, 11, 2) & ":" & _
Mid(dtmInstallDate, 13, 2))
End Function
Sub GetOS_II()
Dim objdtmConvertedDate
Dim objdtmInstallDate As Object
Dim strComputer As String
Dim objWMIService As Object
Dim colOperatingSystems As Object
Dim Msg
Dim objOperatingSystem As Object
strComputer = "."
Set objdtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each objOperatingSystem In colOperatingSystems
Msg = "Boot Device: " & objOperatingSystem.BootDevice & vbCr
Msg = Msg & "Build Number: " & objOperatingSystem.BuildNumber & vbCr
Msg = Msg & "Build Type: " & objOperatingSystem.BuildType & vbCr
Msg = Msg & "Caption: " & objOperatingSystem.Caption & vbCr
Msg = Msg & "Code Set: " & objOperatingSystem.CodeSet & vbCr
Msg = Msg & "Country Code: " & objOperatingSystem.CountryCode & vbCr
Msg = Msg & "Debug: " & objOperatingSystem.Debug & vbCr
Msg = Msg & "Encryption Level: " & objOperatingSystem.EncryptionLevel & vbCr
objdtmConvertedDate.Value = objOperatingSystem.InstallDate
Set objdtmInstallDate = objdtmConvertedDate '.GetVarDate
Msg = Msg & "Install Date: " & WMIDateStringToDate(objdtmInstallDate) & vbCr
Msg = Msg & "Licensed Users: " & objOperatingSystem.NumberOfLicensedUsers & vbCr
Msg = Msg & "Organization: " & objOperatingSystem.Organization & vbCr
Msg = Msg & "OS Language: " & objOperatingSystem.OSLanguage & vbCr
Msg = Msg & "OS Product Suite: " & objOperatingSystem.OSProductSuite & vbCr
Msg = Msg & "OS Type: " & objOperatingSystem.OSType & vbCr
Msg = Msg & "Primary: " & objOperatingSystem.Primary & vbCr
Msg = Msg & "Registered User: " & objOperatingSystem.RegisteredUser & vbCr
Msg = Msg & "Serial Number: " & objOperatingSystem.SerialNumber & vbCr
Msg = Msg & "Version: " & objOperatingSystem.Version & vbCr
MsgBox Msg
Next
End Sub
Sub SysInfo()
'// Retrieve System Information
'// Description
'// Uses WMI to retrieve the same data found in the System Information applet.
Dim strComputer As String
Dim objWMIService As Object
Dim colSettings As Object
Dim objOperatingSystem As Object
Dim Msg, objComputer As Object, objProcessor As Object, objBIOS As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each objOperatingSystem In colSettings
Msg = "OS Name: " & objOperatingSystem.Name & vbCr
Msg = Msg & "Version: " & objOperatingSystem.Version & vbCr
Msg = Msg & "Service Pack: " & _
objOperatingSystem.ServicePackMajorVersion _
& "." & objOperatingSystem.ServicePackMinorVersion & vbCr
Msg = Msg & "OS Manufacturer: " & objOperatingSystem.Manufacturer & vbCr
Msg = Msg & "Windows Directory: " & _
objOperatingSystem.WindowsDirectory & vbCr
Msg = Msg & "Locale: " & objOperatingSystem.Locale & vbCr
Msg = Msg & "Available Physical Memory: " & _
objOperatingSystem.FreePhysicalMemory & vbCr
Msg = Msg & "Total Virtual Memory: " & _
objOperatingSystem.TotalVirtualMemorySize & vbCr
Msg = Msg & "Available Virtual Memory: " & _
objOperatingSystem.FreeVirtualMemory & vbCr
Msg = Msg & "Page file size: " & objOperatingSystem.SizeStoredInPagingFiles & vbCr
MsgBox Msg
Next
Msg = ""
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_ComputerSystem")
For Each objComputer In colSettings
Msg = Msg & "System Name: " & objComputer.Name & vbCr
Msg = Msg & "System Manufacturer: " & objComputer.Manufacturer & vbCr
Msg = Msg & "System Model: " & objComputer.Model & vbCr
Msg = Msg & "Time Zone: " & objComputer.CurrentTimeZone & vbCr
Msg = Msg & "Total Physical Memory: " & _
objComputer.TotalPhysicalMemory & vbCr
MsgBox Msg
Next
Msg = ""
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_Processor")
For Each objProcessor In colSettings
Msg = Msg & "System Type: " & objProcessor.Architecture & vbCr
Msg = Msg & "Processor: " & objProcessor.Description & vbCr
MsgBox Msg
Next
Msg = ""
Set colSettings = objWMIService.ExecQuery _
("Select * from Win32_BIOS")
For Each objBIOS In colSettings
Msg = Msg & "BIOS Version: " & objBIOS.Version & vbCr
MsgBox Msg
Next
End Sub
Private Function strOsType(intOs As Integer) As String
Select Case intOs
Case 0: strOsType = "Unknown"
Case 1: strOsType = "Other"
Case 2: strOsType = "MACOS"
Case 3: strOsType = "ATTUNIX"
Case 4: strOsType = "DGUX"
Case 5: strOsType = "DECNT"
Case 6: strOsType = "Digital Unix"
Case 7: strOsType = "OpenVMS"
Case 8: strOsType = "HPUX"
Case 9: strOsType = "AIX"
Case 10: strOsType = "MVS"
Case 11: strOsType = "OS400"
Case 12: strOsType = "OS/2"
Case 13: strOsType = "JavaVM"
Case 14: strOsType = "MSDOS"
Case 15: strOsType = "WIN3x"
Case 16: strOsType = "WIN95"
Case 17: strOsType = "WIN98"
Case 18: strOsType = "WINNT"
Case 19: strOsType = "WINCE"
Case 20: strOsType = "NCR3000"
Case 21: strOsType = "NetWare"
Case 22: strOsType = "OSF"
Case 23: strOsType = "DC/OS"
Case 24: strOsType = "Reliant UNIX"
Case 25: strOsType = "SCO UnixWare"
Case 26: strOsType = "SCO OpenServer"
Case 27: strOsType = "Sequent"
Case 28: strOsType = "IRIX"
Case 29: strOsType = "Solaris"
Case 30: strOsType = "SunOS"
Case 31: strOsType = "U6000"
Case 32: strOsType = "ASERIES"
Case 33: strOsType = "TandemNSK"
Case 34: strOsType = "TandemNT"
Case 35: strOsType = "BS2000"
Case 36: strOsType = "LINUX"
Case 37: strOsType = "Lynx"
Case 38: strOsType = "XENIX"
Case 39: strOsType = "VM/ESA"
Case 40: strOsType = "Interactive UNIX"
Case 41: strOsType = "BSDUNIX"
Case 42: strOsType = "FreeBSD"
Case 43: strOsType = "NetBSD"
Case 44: strOsType = "GNU Hurd"
Case 45: strOsType = "OS9"
Case 46: strOsType = "MACH Kernel"
Case 47: strOsType = "Inferno"
Case 48: strOsType = "QNX"
Case 49: strOsType = "EPOC"
Case 50: strOsType = "IxWorks"
Case 51: strOsType = "VxWorks"
Case 52: strOsType = "MiNT"
Case 53: strOsType = "BeOS"
Case 54: strOsType = "HP MPE"
Case 55: strOsType = "NextStep"
Case 56: strOsType = "PalmPilot"
Case 57: strOsType = "Rhapsody"
End Select
End Function
Private Function strOsLang(intOsLang As Integer) As String
Select Case intOsLang
Case 1: strOsLang = " Arabic "
Case 4: strOsLang = " Chinese "
Case 9: strOsLang = " English "
Case 1025: strOsLang = " Arabic (Saudi Arabia) "
Case 1026: strOsLang = " Bulgarian "
Case 1027: strOsLang = " Catalan "
Case 1028: strOsLang = " Chinese (Taiwan) "
Case 1029: strOsLang = " Czech "
Case 1030: strOsLang = " Danish "
Case 1031: strOsLang = " German (Germany) "
Case 1032: strOsLang = " Greek "
Case 1033: strOsLang = " English (United States) "
Case 1034: strOsLang = " Spanish (Traditional Sort) "
Case 1035: strOsLang = " Finnish "
Case 1036: strOsLang = " French (France) "
Case 1037: strOsLang = " Hebrew "
Case 1038: strOsLang = " Hungarian "
Case 1039: strOsLang = " Icelandic "
Case 1040: strOsLang = " Italian (Italy) "
Case 1041: strOsLang = " Japanese "
Case 1042: strOsLang = " Korean "
Case 1043: strOsLang = " Dutch (Netherlands) "
Case 1044: strOsLang = " Norwegian (Bokmal) "
Case 1045: strOsLang = " Polish "
Case 1046: strOsLang = " Portuguese (Brazil) "
Case 1047: strOsLang = " Rhaeto-Romanic "
Case 1048: strOsLang = " Romanian "
Case 1049: strOsLang = " Russian "
Case 1050: strOsLang = " Croatian "
Case 1051: strOsLang = " Slovak "
Case 1052: strOsLang = " Albanian "
Case 1053: strOsLang = " Swedish "
Case 1054: strOsLang = " Thai "
Case 1055: strOsLang = " Turkish "
Case 1056: strOsLang = " Urdu "
Case 1057: strOsLang = " Indonesian "
Case 1058: strOsLang = " Ukrainian "
Case 1059: strOsLang = " Belarusian "
Case 1060: strOsLang = " Slovenian "
Case 1061: strOsLang = " Estonian "
Case 1062: strOsLang = " Latvian "
Case 1063: strOsLang = " Lithuanian "
Case 1065: strOsLang = " Farsi "
Case 1066: strOsLang = " Vietnamese "
Case 1069: strOsLang = " Basque "
Case 1070: strOsLang = " Sorbian "
Case 1071: strOsLang = " Macedonian (FYROM) "
Case 1072: strOsLang = " Sutu "
Case 1073: strOsLang = " Tsonga "
Case 1074: strOsLang = " Tswana "
Case 1076: strOsLang = " Xhosa "
Case 1077: strOsLang = " Zulu "
Case 1078: strOsLang = " Afrikaans "
Case 1080: strOsLang = " Faeroese "
Case 1081: strOsLang = " Hindi "
Case 1082: strOsLang = " Maltese "
Case 1084: strOsLang = " Gaelic "
Case 1085: strOsLang = " Yiddish "
Case 1086: strOsLang = " Malay (Malaysia) "
Case 2049: strOsLang = " Arabic (Iraq) "
Case 2052: strOsLang = " Chinese (PRC) "
Case 2055: strOsLang = " German (Switzerland) "
Case 2057: strOsLang = " English (United Kingdom) "
Case 2058: strOsLang = " Spanish (Mexico) "
Case 2060: strOsLang = " French (Belgium) "
Case 2064: strOsLang = " Italian (Switzerland) "
Case 2067: strOsLang = " Dutch (Belgium) "
Case 2068: strOsLang = " Norwegian (Nynorsk) "
Case 2070: strOsLang = " Portuguese (Portugal) "
Case 2072: strOsLang = " Romanian (Moldova) "
Case 2073: strOsLang = " Russian (Moldova) "
Case 2074: strOsLang = " Serbian (Latin) "
Case 2077: strOsLang = " Swedish (Finland) "
Case 3073: strOsLang = " Arabic (Egypt) "
Case 3076: strOsLang = " Chinese (Hong Kong SAR) "
Case 3079: strOsLang = " German (Austria) "
Case 3081: strOsLang = " English (Australia) "
Case 3082: strOsLang = " Spanish (International Sort) "
Case 3084: strOsLang = " French (Canada) "
Case 3098: strOsLang = " Serbian (Cyrillic) "
Case 4097: strOsLang = " Arabic (Libya) "
Case 4100: strOsLang = " Chinese (Singapore) "
Case 4103: strOsLang = " German (Luxembourg) "
Case 4105: strOsLang = " English (Canada) "
Case 4106: strOsLang = " Spanish (Guatemala) "
Case 4108: strOsLang = " French (Switzerland) "
Case 5121: strOsLang = " Arabic (Algeria) "
Case 5127: strOsLang = " German (Liechtenstein) "
Case 5129: strOsLang = " English (New Zealand) "
Case 5130: strOsLang = " Spanish (Costa Rica) "
Case 5132: strOsLang = " French (Luxembourg) "
Case 6145: strOsLang = " Arabic (Morocco) "
Case 6153: strOsLang = " English (Ireland) "
Case 6154: strOsLang = " Spanish (Panama) "
Case 7169: strOsLang = " Arabic (Tunisia) "
Case 7177: strOsLang = " English (South Africa) "
Case 7178: strOsLang = " Spanish (Dominican Republic) "
Case 8193: strOsLang = " Arabic (Oman) "
Case 8201: strOsLang = " English (Jamaica) "
Case 8202: strOsLang = " Spanish (Venezuela) "
Case 9217: strOsLang = " Arabic (Yemen) "
Case 9226: strOsLang = " Spanish (Colombia) "
Case 10241: strOsLang = " Arabic (Syria) "
Case 10249: strOsLang = " English (Belize) "
Case 10250: strOsLang = " Spanish (Peru) "
Case 11265: strOsLang = " Arabic (Jordan) "
Case 11273: strOsLang = " English (Trinidad) "
Case 11274: strOsLang = " Spanish (Argentina) "
Case 12289: strOsLang = " Arabic (Lebanon) "
Case 12298: strOsLang = " Spanish (Ecuador) "
Case 13313: strOsLang = " Arabic (Kuwait) "
Case 13322: strOsLang = " Spanish (Chile) "
Case 14337: strOsLang = " Arabic (U.A.E.) "
Case 14346: strOsLang = " Spanish (Uruguay) "
Case 15361: strOsLang = " Arabic (Bahrain) "
Case 15370: strOsLang = " Spanish (Paraguay) "
Case 16385: strOsLang = " Arabic (Qatar) "
Case 16394: strOsLang = " Spanish (Bolivia) "
Case 17418: strOsLang = " Spanish (El Salvador) "
Case 18442: strOsLang = " Spanish (Honduras) "
Case 19466: strOsLang = " Spanish (Nicaragua) "
Case 20490: strOsLang = " Spanish (Puerto Rico) "
End Select
End Function