VB WMI 对象的示例代码
2008-03-29 16:23
295 查看
Attribute VB_Name = "ModuleWMI"
'Powered by barenx
Option Explicit
Private Declare Function ExpandEnvironmentStrings()Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Private Declare Function lstrlen()Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Const MAX_PATH = 260
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiBiosInfo()Function wmiBiosInfo() As String
Dim BiosSet As SWbemObjectSet
Dim bios As SWbemObject
Dim Cnt As Long
Dim Msg As String
Set BiosSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_BIOS")
On Local Error Resume Next
For Each bios In BiosSet
wmiBiosInfo = wmiBiosInfo & "PrimaryBIOS" & vbTab & bios.PrimaryBIOS & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Status" & vbTab & bios.Status & vbCrLf
For Cnt = LBound(bios.BIOSVersion) To UBound(bios.BIOSVersion)
wmiBiosInfo = wmiBiosInfo & "BIOSVersion strings" & vbTab & bios.BIOSVersion(Cnt) & vbCrLf
Next Cnt
wmiBiosInfo = wmiBiosInfo & "Caption" & vbTab & bios.Caption & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Description" & vbTab & bios.Description & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Name" & vbTab & bios.Name & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Manufacturer" & vbTab & bios.Manufacturer & vbCrLf
wmiBiosInfo = wmiBiosInfo & "ReleaseDate" & vbTab & bios.ReleaseDate & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SerialNumber" & vbTab & bios.SerialNumber & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SMBIOSBIOSVersion" & vbTab & bios.SMBIOSBIOSVersion & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SMBIOSMajorVersion" & vbTab & bios.SMBIOSMajorVersion & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SMBIOSMinorVersion" & vbTab & bios.SMBIOSMinorVersion & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SMBIOSPresent" & vbTab & bios.SMBIOSPresent & vbCrLf
wmiBiosInfo = wmiBiosInfo & "SoftwareElementID" & vbTab & bios.SoftwareElementID & vbCrLf
Select Case bios.SoftwareElementState
Case 0: Msg = "deployable"
Case 1: Msg = "installable"
Case 2: Msg = "executable"
Case 3: Msg = "running"
End Select
wmiBiosInfo = wmiBiosInfo & "SoftwareElementState" & vbTab & Msg & vbCrLf
wmiBiosInfo = wmiBiosInfo & "Version" & vbTab & bios.Version & vbCrLf
wmiBiosInfo = wmiBiosInfo & "InstallableLanguages" & vbTab & bios.InstallableLanguages & vbCrLf
wmiBiosInfo = wmiBiosInfo & "CurrentLanguage" & vbTab & bios.CurrentLanguage & vbCrLf
For Cnt = LBound(bios.ListOfLanguages) To UBound(bios.ListOfLanguages)
wmiBiosInfo = wmiBiosInfo & "ListOfLanguages" & vbTab & bios.ListOfLanguages(Cnt) & vbCrLf
Next Cnt
For Cnt = LBound(bios.BiosCharacteristics) To UBound(bios.BiosCharacteristics)
Select Case bios.BiosCharacteristics(Cnt)
Case 0: Msg = "reserved"
Case 1: Msg = "reserved"
Case 2: Msg = "unknown"
Case 3: Msg = "BIOS characteristics not supported"
Case 4: Msg = "ISA supported"
Case 5: Msg = "MCA supported"
Case 6: Msg = "EISA supported"
Case 7: Msg = "PCI supported"
Case 8: Msg = "PC Card (PCMCIA) supported"
Case 9: Msg = "Plug and Play supported"
Case 10: Msg = "APM is supported"
Case 11: Msg = "BIOS upgradable (Flash)"
Case 12: Msg = "BIOS shadowing allowed"
Case 13: Msg = "VL-VESA supported"
Case 14: Msg = "ESCD support available"
Case 15: Msg = "Boot from CD supported"
Case 16: Msg = "Selectable boot supported"
Case 17: Msg = "BIOS ROM socketed"
Case 18: Msg = "Boot from PC card (PCMCIA) supported"
Case 19: Msg = "EDD (Enhanced Disk Drive) specification supported"
Case 20: Msg = "Int 13h, Japanese Floppy for NEC 9800 1.2mb (3.5, 1k b/s, 360 RPM) supported"
Case 21: Msg = "Int 13h, Japanese Floppy for Toshiba 1.2mb (3.5, 360 RPM) supported"
Case 22: Msg = "Int 13h, 5.25 / 360 KB floppy services supported"
Case 23: Msg = "Int 13h, 5.25 /1.2MB floppy services supported"
Case 24: Msg = "Int 13h 3.5 / 720 KB floppy services supported"
Case 25: Msg = "Int 13h, 3.5 / 2.88 MB floppy services supported"
Case 26: Msg = "Int 5h, print screen service supported"
Case 27: Msg = "Int 9h, 8042 keyboard services supported"
Case 28: Msg = "Int 14h, serial services supported"
Case 29: Msg = "Int 17h, printer services supported"
Case 30: Msg = "Int 10h, CGA/Mono video aervices supported"
Case 31: Msg = "NEC PC-98"
Case 32: Msg = "ACPI supported"
Case 33: Msg = "USB Legacy supported"
Case 34: Msg = "AGP supported"
Case 35: Msg = "I2O boot supported"
Case 36: Msg = "LS-120 boot supported"
Case 37: Msg = "ATAPI ZIP drive boot supported"
Case 38: Msg = "1394 boot supported"
Case 39: Msg = "Smart battery supported"
End Select
wmiBiosInfo = wmiBiosInfo & "BIOS Characteristics" & vbTab & Msg & vbCrLf
Next Cnt 'For cnt
wmiBiosInfo = wmiBiosInfo & vbCrLf
Next bios 'For Each bios
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiDesktopInfo()Function wmiDesktopInfo() As String
Dim DesktopSet As SWbemObjectSet
Dim desktop As SWbemObject
Dim Thiscol As Long
wmiDesktopInfo = wmiDesktopInfo & "WMI Property" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "BorderWidth" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "CoolSwitch" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "CursorBlinkRate" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "DragFullWindows" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "GridGranularity" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "IconSpacing" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "IconTitleFaceName" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "IconTitleSize" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "IconTitleWrap" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "Pattern" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "ScrSaveActive" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "ScrSaveExecutable" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "ScrSaveSecure" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "ScrSaveTimeout" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "Wallpaper" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "WallpaperStretched" & vbTab
wmiDesktopInfo = wmiDesktopInfo & "WallpaperTiled" & vbTab
wmiDesktopInfo = wmiDesktopInfo & vbCrLf
Set DesktopSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_Desktop")
For Each desktop In DesktopSet
wmiDesktopInfo = wmiDesktopInfo & desktop.Name & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.BorderWidth & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.CoolSwitch & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.CursorBlinkRate & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.DragFullWindows & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.GridGranularity & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.IconSpacing & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.IconTitleFaceName & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.IconTitleSize & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.IconTitleWrap & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.Pattern & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.ScreenSaverActive & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.ScreenSaverExecutable & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.ScreenSaverSecure & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.ScreenSaverTimeout & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.Wallpaper & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.WallpaperStretched & vbTab
wmiDesktopInfo = wmiDesktopInfo & desktop.WallpaperTiled
wmiDesktopInfo = wmiDesktopInfo & vbCrLf
Next desktop
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiDiskDriveInfo()Function wmiDiskDriveInfo() As String
Dim DiskDriveSet As SWbemObjectSet
Dim dd As SWbemObject
Dim Thiscol As Long
Dim capcount As Long
Dim Msg As String
Dim sflag As String 'used in err trap
On Local Error Resume Next
wmiDiskDriveInfo = wmiDiskDriveInfo & "WMI Property" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Description" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Index" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: DeviceID" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Caption" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Manufacturer" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: Model" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: InterfaceType" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: MediaLoaded" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "ID: MediaType" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: Status" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: Size" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: Partitions" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: BytesPerSector" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: SectorsPerTrack" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: TotalCylinders" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: TotalHeads" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: TotalTracks" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & "Phyical: TracksPerCylinder"
wmiDiskDriveInfo = wmiDiskDriveInfo & "Disk Capabilities:" & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & vbCrLf
Set DiskDriveSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_DiskDrive")
For Each dd In DiskDriveSet
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Description & " " & dd.Index & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Description & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Index & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.DeviceID & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Caption & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Manufacturer & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Model & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.InterfaceType & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.MediaLoaded & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.MediaType & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Status & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & FormatNumber(dd.Size, 0) & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.Partitions & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & FormatNumber(dd.BytesPerSector, 0) & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & FormatNumber(dd.SectorsPerTrack, 0) & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & FormatNumber(dd.TotalCylinders, 0) & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.TotalHeads & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.TotalTracks & vbTab
wmiDiskDriveInfo = wmiDiskDriveInfo & dd.TracksPerCylinder & vbTab
For capcount = LBound(dd.capabilities) To UBound(dd.capabilities)
Select Case dd.capabilities(capcount)
Case 0: Msg = "Unknown "
Case 1: Msg = "Other "
Case 2: Msg = "Sequential Access "
Case 3: Msg = "Random Access "
Case 4: Msg = "Supports Writing "
Case 5: Msg = "Encryption "
Case 6: Msg = "Compression "
Case 7: Msg = "Supports Removable Media "
Case 8: Msg = "Manual Cleaning "
Case 9: Msg = "Automatic Cleaning "
Case 10: Msg = "SMART Notification "
Case 11: Msg = "Supports Dual Sided Media "
Case 12: Msg = "Ejection Prior to Drive Dismount Not Required"
End Select
wmiDiskDriveInfo = wmiDiskDriveInfo & Msg & vbTab
Next capcount
wmiDiskDriveInfo = wmiDiskDriveInfo & vbCrLf
Next dd
'--end block--'
End Function
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiVideoControllerInfo()Function wmiVideoControllerInfo() As String
Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Dim Msg As String
wmiVideoControllerInfo = wmiVideoControllerInfo & "Processor" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "BPS" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Hres" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Vres" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Freq" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Colours" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "rf min" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "rf max" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Vmode" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "Mem" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & "AdapterDACType" & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & vbCrLf
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_VideoController")
On Local Error Resume Next
For Each obj In wmiObjSet
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.VideoProcessor & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentBitsPerPixel & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentHorizontalResolution & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentVerticalResolution & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentRefreshRate & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.CurrentNumberOfColors & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.MinRefreshRate & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.MaxRefreshRate & vbTab
Select Case obj.CurrentScanMode
Case 1: Msg = "other"
Case 2: Msg = "unknwn"
Case 3: Msg = "intrlcd"
Case 4: Msg = "nintrlcd"
End Select
wmiVideoControllerInfo = wmiVideoControllerInfo & Msg & vbTab
Select Case obj.VideoMemoryType
Case 1: Msg = "other"
Case 2: Msg = "unknown"
Case 3: Msg = "VRAM"
Case 4: Msg = "DRAM"
Case 5: Msg = "SRAM"
Case 6: Msg = "WRAM"
Case 7: Msg = "EDO RAM"
Case 8: Msg = "Burst Synchronous DRAM"
Case 9: Msg = "Pipelined Burst SRAM"
Case 10: Msg = "CDRAM"
Case 11: Msg = "3DRAM"
Case 12: Msg = "SDRAM"
Case 13: Msg = "SGRAM"
End Select
wmiVideoControllerInfo = wmiVideoControllerInfo & Msg & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & obj.AdapterDACType & vbTab
wmiVideoControllerInfo = wmiVideoControllerInfo & vbCrLf
Next obj
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiDisplayConfiguration()Function wmiDisplayConfiguration() As String
Dim dcSet As SWbemObjectSet
Dim dc As SWbemObject
Dim Msg As String
wmiDisplayConfiguration = wmiDisplayConfiguration & "Caption" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "Driver ver" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "LogPixels" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "PelsH" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "PelsV" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & "Spec ver" & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & vbCrLf
Set dcSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_DisplayConfiguration")
On Local Error Resume Next
For Each dc In dcSet
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.Caption & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.DriverVersion & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.LogPixels & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.PelsHeight & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.PelsWidth & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & dc.SpecificationVersion & vbTab
wmiDisplayConfiguration = wmiDisplayConfiguration & vbCrLf
Next dc
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Private Function ChangeEnvironmentToPath()Function ChangeEnvironmentToPath(ByVal sEnvironPath As String) As String
Dim buff As String
buff = Space$(MAX_PATH)
Call ExpandEnvironmentStrings(sEnvironPath, buff, Len(buff))
ChangeEnvironmentToPath = Left$(buff, lstrlen(StrPtr(buff)))
End Function
Public Function wmiEnvironmentInfo()Function wmiEnvironmentInfo() As String
wmiEnvironmentInfo = wmiEnvironmentInfo & "Variable Name" & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & "Environment Value" & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & "Expanded String" & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & vbCrLf
Dim EnvSet As SWbemObjectSet
Dim env As SWbemObject
Set EnvSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_Environment")
On Local Error Resume Next
For Each env In EnvSet
wmiEnvironmentInfo = wmiEnvironmentInfo & env.Name & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & env.VariableValue & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & ChangeEnvironmentToPath(env.VariableValue) & vbTab
wmiEnvironmentInfo = wmiEnvironmentInfo & vbCrLf
Next env
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiKeyboardInfo()Function wmiKeyboardInfo() As String
Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Dim Thiscol As Long
On Local Error Resume Next
wmiKeyboardInfo = wmiKeyboardInfo & "WMI Property" & vbTab
wmiKeyboardInfo = wmiKeyboardInfo & "Value" & vbTab
wmiKeyboardInfo = wmiKeyboardInfo & vbCrLf
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_Keyboard")
For Each obj In wmiObjSet
wmiKeyboardInfo = wmiKeyboardInfo & "Description" & vbTab & obj.Description & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Name" & vbTab & obj.Name & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Caption" & vbTab & obj.Caption & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Status" & vbTab & obj.Status & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Availability" & vbTab & IIf(obj.Availability, obj.Availability, "null") & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "Layout" & vbTab & obj.Layout & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "NumberOfFunctionKeys" & vbTab & obj.NumberOfFunctionKeys & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "DeviceID" & vbTab & obj.DeviceID & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & "PNPDeviceID" & vbTab & obj.PNPDeviceID & vbCrLf
wmiKeyboardInfo = wmiKeyboardInfo & vbCrLf
Next obj
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiBaseBoardInfo()Function wmiBaseBoardInfo() As String
wmiBaseBoardInfo = wmiBaseBoardInfo & "Product" & vbTab
wmiBaseBoardInfo = wmiBaseBoardInfo & "Manufacturer" & vbTab
Dim BaseBoardSet As SWbemObjectSet
Dim bb As SWbemObject
Set BaseBoardSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_BaseBoard")
On Local Error Resume Next
For Each bb In BaseBoardSet
wmiBaseBoardInfo = wmiBaseBoardInfo & "Manufacturer" & vbTab & bb.Manufacturer & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Caption" & vbTab & bb.Caption & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "ConfigOptions" & vbTab & bb.ConfigOptions & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "CreationClassName" & vbTab & bb.CreationClassName & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Depth" & vbTab & bb.Depth & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Description" & vbTab & bb.Description & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Height" & vbTab & bb.Height & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "HostingBoard" & vbTab & bb.HostingBoard & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "HotSwappable" & vbTab & bb.HotSwappable & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "InstallDate" & vbTab & bb.InstallDate & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Model" & vbTab & bb.Model & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Name" & vbTab & bb.Name & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "OtherIdentifyingInfo" & vbTab & bb.OtherIdentifyingInfo & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "PartNumber" & vbTab & bb.PartNumber & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "PoweredOn" & vbTab & bb.PoweredOn & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Product" & vbTab & bb.Product & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Removable" & vbTab & bb.Removable & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Replaceable" & vbTab & bb.Replaceable & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "RequirementsDescription" & vbTab & bb.RequirementsDescription & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "RequiresDaughterBoard" & vbTab & bb.RequiresDaughterBoard & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "SerialNumber" & vbTab & bb.SerialNumber & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "SKU" & vbTab & bb.SKU & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "SlotLayout" & vbTab & bb.SlotLayout & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "SpecialRequirements" & vbTab & bb.SpecialRequirements & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Status" & vbTab & bb.Status & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Tag" & vbTab & bb.Tag & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Version" & vbTab & bb.Version & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Weight" & vbTab & bb.Weight & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & "Width" & vbTab & bb.Width & vbCrLf
wmiBaseBoardInfo = wmiBaseBoardInfo & vbCrLf
Next bb
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiDesktopMonitorInfo()Function wmiDesktopMonitorInfo() As String
Dim dtmSet As SWbemObjectSet
Dim dtm As SWbemObject
Dim Msg As String
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Device ID" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Caption" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Manu" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Stat" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & "Availability" & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & vbCrLf
Set dtmSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_DesktopMonitor")
On Local Error Resume Next
For Each dtm In dtmSet
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & dtm.DeviceID & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & dtm.Caption & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & dtm.MonitorManufacturer & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & dtm.Status & vbTab
Select Case dtm.Availability
Case 1: Msg = "other"
Case 2: Msg = "unknown "
Case 3: Msg = "running/full power"
Case 4: Msg = "warning "
Case 5: Msg = "in test "
Case 6: Msg = "not applicable "
Case 7: Msg = "power off "
Case 8: Msg = "off line "
Case 9: Msg = "off duty "
Case 10: Msg = "degraded "
Case 11: Msg = "not installed "
Case 12: Msg = "install error "
Case 13: Msg = "power save - unknown "
Case 14: Msg = "power save - low power mode "
Case 15: Msg = "power save - standby "
Case 16: Msg = "power cycle "
Case 17: Msg = "power save - warning "
Case 18: Msg = "paused "
Case 19: Msg = "not ready "
Case 20: Msg = "not configured "
Case 21: Msg = "quiesced"
End Select
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & Msg & vbTab
wmiDesktopMonitorInfo = wmiDesktopMonitorInfo & vbCrLf
Next dtm
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Private Function SplitDateTimeBias()Function SplitDateTimeBias(ByVal leasedate As String, leasedatepart As String, leasetimepart As String) As Long
Dim pos As Long, bias As Long
pos = InStr(leasedate, ".")
If pos > 0 Then
bias = StripTimeZoneBias(leasedate)
leasedatepart = Left$(leasedate, 8)
leasetimepart = Mid$(leasedate, 9, pos - Len(leasedatepart) - 1)
leasedatepart = InsertInString(leasedatepart, "-", 5, "")
leasedatepart = InsertInString(leasedatepart, "-", 8, "")
leasetimepart = InsertInString(leasetimepart, ":", 3, "")
leasetimepart = InsertInString(leasetimepart, ":", 6, "")
SplitDateTimeBias = bias
End If
End Function
Private Function InsertInString()Function InsertInString(ByVal sOriginal As String, sReplace As String, nField As Long, sDelimeter As String) As String
Dim nCount As Long, nStart As Long, nLast As Long
Do While InStr(nStart + 1, sOriginal, sDelimeter) > 0
nStart = InStr(nStart + 1, sOriginal, sDelimeter)
nCount = nCount + 1
If nCount >= nField Then
Exit Do
End If
nLast = nStart
Loop
Select Case nCount
Case 1
InsertInString = sReplace & Mid$(sOriginal, nStart)
Case Is >= nField
InsertInString = Mid$(sOriginal, 1, nLast) & sReplace & Mid$(sOriginal, nStart)
Case Else
InsertInString = sOriginal & String$((nField - 1) - nCount, sDelimeter) & sReplace
End Select
End Function
Private Function StripTimeZoneBias()Function StripTimeZoneBias(leasedate As String) As Long
Dim pos As Long, tmp As String
pos = InStr(leasedate, "-")
If pos = 0 Then
pos = InStr(leasedate, "+")
If pos = 0 Then
StripTimeZoneBias = 0
End If
Else
tmp = Mid$(leasedate, pos, Len(leasedate))
leasedate = Mid$(leasedate, 1, pos - 1)
StripTimeZoneBias = CLng(tmp)
End If
End Function
Public Function wmiOperatingSystemInfo()Function wmiOperatingSystemInfo() As String
Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Dim Msg As String
Dim dtb As String
Dim d As String
Dim t As String
Dim bias As Long
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "WMI Property" & vbTab
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Value(s)" & vbTab
wmiOperatingSystemInfo = wmiOperatingSystemInfo & vbCrLf
On Local Error Resume Next
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_OperatingSystem")
For Each obj In wmiObjSet
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Operating System" & vbTab & obj.Caption & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Version" & vbTab & obj.Version & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "BuildNumber" & vbTab & obj.BuildNumber & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "BuildType" & vbTab & obj.BuildType & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Latest Service Pack" & vbTab & obj.CSDVersion & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "EncryptionLevel" & vbTab & obj.EncryptionLevel & "-bit" & vbCrLf
Select Case obj.OSType
Case 15: Msg = "WIN3x"
Case 16: Msg = "WIN95"
Case 17: Msg = "WIN98"
Case 18: Msg = "WINNT"
Case 19: Msg = "WINCE"
Case Else: Msg = "non-windows - see MSDN for complete list"
End Select
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "OSType" & vbTab & Msg & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "BootDevice" & vbTab & obj.BootDevice & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "RegisteredUser" & vbTab & obj.RegisteredUser & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SerialNumber" & vbTab & obj.SerialNumber & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Status" & vbTab & obj.Status & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SystemDevice" & vbTab & obj.SystemDevice & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SystemDrive" & vbTab & obj.SystemDrive & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "WindowsDirectory" & vbTab & obj.WindowsDirectory & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SystemDirectory" & vbTab & obj.SystemDirectory & vbCrLf
dtb = obj.LocalDateTime
bias = SplitDateTimeBias(dtb, d, t)
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "LocalDateTime" & vbTab & Format$(d, "dddd mmm d, yyyy") & " " & Format$(t, "hh:mm") & " (includes " & bias & " bias)" & vbCrLf
dtb = obj.InstallDate
bias = SplitDateTimeBias(dtb, d, t)
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "InstallDate" & vbTab & Format$(d, "dddd mmm d, yyyy") & " at " & Format$(t, "hh:mm") & " (includes " & bias & " bias)" & vbCrLf
dtb = obj.LastBootUpTime
bias = SplitDateTimeBias(dtb, d, t)
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "LastBootUpTime" & vbTab & Format$(d, "dddd mmm d, yyyy") & " at " & Format$(t, "hh:mm") & " (includes " & bias & " bias)" & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "OSLanguage" & vbTab & obj.OSLanguage & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "CodeSet" & vbTab & obj.CodeSet & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "Locale" & vbTab & obj.Locale & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "CountryCode" & vbTab & obj.CountryCode & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "CurrentTimeZone" & vbTab & obj.CurrentTimeZone & vbCrLf
Select Case obj.ForegroundApplicationBoost
Case 0: Msg = "none"
Case 1: Msg = "minimum"
Case 2: Msg = "maximum (default)"
End Select
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "ForegroundApplicationBoost" & vbTab & Msg & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "TotalVisibleMemorySize" & vbTab & FormatNumber(obj.TotalVisibleMemorySize, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "FreePhysicalMemory" & vbTab & FormatNumber(obj.FreePhysicalMemory, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "TotalVirtualMemorySize" & vbTab & FormatNumber(obj.TotalVirtualMemorySize, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "FreeVirtualMemory" & vbTab & FormatNumber(obj.FreeVirtualMemory, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "FreeSpaceInPagingFiles" & vbTab & FormatNumber(obj.FreeSpaceInPagingFiles, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & "SizeStoredInPagingFiles" & FormatNumber(obj.SizeStoredInPagingFiles, 0) & vbCrLf
wmiOperatingSystemInfo = wmiOperatingSystemInfo & vbCrLf
Next obj
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiPointingDeviceInfo()Function wmiPointingDeviceInfo() As String
Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Dim Msg As String
Dim Thiscol As Long
On Local Error Resume Next
'add first column and set initial parameters
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "WMI Property" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Description" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Status" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "ConfigManagerErrorCode" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Manufacturer" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Name" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "HardwareType" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "DeviceInterface" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "DoubleSpeedThreshold" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "Handedness" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "NumberOfButtons" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "PointingType" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "QuadSpeedThreshold" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "DeviceID" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & "PNPDeviceID" & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & vbCrLf
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_PointingDevice")
For Each obj In wmiObjSet
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Description & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Description & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Status & vbTab
Select Case obj.ConfigManagerErrorCode
Case 0: Msg = "This device is working properly."
Case 1: Msg = "This device is not configured correctly."
Case 2: Msg = "Windows cannot load the driver for this device."
Case 3: Msg = "The driver might be corrupted, or your system " & "may be running low on memory or other resources."
Case 4: Msg = "This device is not working properly. One of its " & "drivers or your registry might be corrupted."
Case 5: Msg = "The driver for this device needs a resource " & "that Windows cannot manage."
Case 6: Msg = "The boot configuration for this device " & "conflicts with other devices."
Case 7: Msg = "Cannot filter."
Case 8: Msg = "The driver loader for the device is missing."
Case 9: Msg = "This device is not working properly because" & "the controlling firmware is reporting the " & "resources for the device incorrectly."
Case 10: Msg = "This device cannot start."
Case 11: Msg = "This device failed."
Case 12: Msg = "This device cannot find enough free " & "resources that it can use."
Case 13: Msg = "Windows cannot verify this device's resources."
Case 14: Msg = "This device cannot work properly until " & "you restart your computer."
Case 15: Msg = "This device is not working properly because " & "there is probably a re-enumeration problem."
Case 16: Msg = "Windows cannot identify all the resources this device uses."
Case 17: Msg = "This device is asking for an unknown resource type."
Case 18: Msg = "Reinstall the drivers for this device."
Case 19: Msg = "Failure using the VXD loader."
Case 20: Msg = "Your registry might be corrupted."
Case 21: Msg = "System failure: Try changing the driver for this device. " & "If that does not work, see your hardware " & "documentation. Windows is removing this device."
Case 22: Msg = "This device is disabled."
Case 23: Msg = "System failure: Try changing the driver for " & "this device. If that doesn't work, see your " & "hardware documentation."
Case 24: Msg = "This device is not present, is not working " & "properly, or does not have all its drivers installed."
Case 25: Msg = "Windows is still setting up this device."
Case 26: Msg = "Windows is still setting up this device."
Case 27: Msg = "This device does not have valid log configuration."
Case 28: Msg = "The drivers for this device are not installed."
Case 29: Msg = "This device is disabled because the firmware of " & "the device did not give it the required resources."
Case 30: Msg = "This device is using an Interrupt Request (IRQ) " & "resource that another device is using."
Case 31: Msg = "This device is not working properly because Windows " & "cannot load the drivers required for this device."
End Select
wmiPointingDeviceInfo = wmiPointingDeviceInfo & Msg & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Manufacturer & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Name & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.HardwareType & vbTab
Select Case obj.DeviceInterface
Case 1: Msg = "Other"
Case 2: Msg = "Unknown"
Case 3: Msg = "Serial"
Case 4: Msg = "PS/2"
Case 5: Msg = "Infrared"
Case 6: Msg = "HP-HIL"
Case 7: Msg = "Bus mouse"
Case 8: Msg = "ADB (Apple Desktop Bus)"
Case 160: Msg = "Bus mouse DB-9"
Case 161: Msg = "Bus mouse micro-DIN"
Case 162: Msg = "USB"
End Select
wmiPointingDeviceInfo = wmiPointingDeviceInfo & Msg & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.DoubleSpeedThreshold & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.Handedness & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.NumberOfButtons & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.PointingType & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.QuadSpeedThreshold & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.DeviceID & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & obj.PNPDeviceID & vbTab
wmiPointingDeviceInfo = wmiPointingDeviceInfo & vbCrLf
Next obj
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiSystemSlotInfo()Function wmiSystemSlotInfo() As String
Dim wmiObjSet As SWbemObjectSet
Dim obj As SWbemObject
Dim Thiscol As Long
Dim capcount As Long
Dim Msg As String
Dim Cnt As Long
On Local Error Resume Next
wmiSystemSlotInfo = wmiSystemSlotInfo & "WMI Property" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Number" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Description" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Tag" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Status" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "ConnectorPinout" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "CurrentUsage" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "MaxDataWidth" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "PMESignal" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "Shared" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "SupportsHotPlug" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "VccMixedVoltageSupport" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & "ConnectorType" & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & vbCrLf
Set wmiObjSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_SystemSlot")
For Each obj In wmiObjSet
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.SlotDesignation & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & IIf(obj.Number, obj.Number, "null") & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.Description & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.Tag & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.Status & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & IIf(obj.ConnectorPinout, obj.ConnectorPinout, "null") & vbTab
Select Case obj.CurrentUsage
Case 0: Msg = "Reserved"
Case 1: Msg = "Other"
Case 2: Msg = "Unknown"
Case 3: Msg = "Available"
Case 4: Msg = "In use"
End Select
wmiSystemSlotInfo = wmiSystemSlotInfo & Msg & vbTab
Select Case obj.MaxDataWidth
Case 0: Msg = "8"
Case 1: Msg = "16"
Case 2: Msg = "32"
Case 3: Msg = "64"
Case 4: Msg = "128"
End Select
wmiSystemSlotInfo = wmiSystemSlotInfo & Msg & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.PMESignal & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.Shared & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & obj.SupportsHotPlug & vbTab
For Cnt = LBound(obj.VccMixedVoltageSupport) To UBound(obj.VccMixedVoltageSupport)
Select Case obj.VccMixedVoltageSupport(Cnt)
Case 0: Msg = Msg & "Unknown "
Case 1: Msg = Msg & "Other "
Case 2: Msg = Msg & "3.3v "
Case 3: Msg = Msg & "5v "
Case Else: Msg = ""
End Select
Next Cnt
wmiSystemSlotInfo = wmiSystemSlotInfo & Msg & vbTab
For capcount = LBound(obj.ConnectorType) To UBound(obj.ConnectorType)
Select Case obj.ConnectorType(capcount)
Case 0: Msg = " Unknown"
Case 1: Msg = " Other"
Case 2: Msg = " Male"
Case 3: Msg = " Female"
Case 4: Msg = " Shielded"
Case 5: Msg = " Unshielded"
Case 6: Msg = " SCSI (A) High-Density (50 pins)"
Case 7: Msg = " SCSI (A) Low-Density (50 pins)"
Case 8: Msg = " SCSI (P) High-Density (68 pins)"
Case 9: Msg = " SCSI SCA-I (80 pins)"
Case 10: Msg = "SCSI SCA-II (80 pins)"
Case 11: Msg = "SCSI Fibre Channel (DB-9, Copper)"
Case 12: Msg = "SCSI Fibre Channel (Fibre)"
Case 13: Msg = "SCSI Fibre Channel SCA-II (40 pins)"
Case 14: Msg = "SCSI Fibre Channel SCA-II (20 pins)"
Case 15: Msg = "SCSI Fibre Channel BNC"
Case 16: Msg = "ATA 3-1/2 Inch (40 pins)"
Case 17: Msg = "ATA 2-1/2 Inch (44 pins)"
Case 18: Msg = "ATA-2"
Case 19: Msg = "ATA-3"
Case 20: Msg = "ATA/66"
Case 21: Msg = "DB-9"
Case 22: Msg = "DB-15"
Case 23: Msg = "DB-25"
Case 24: Msg = "DB-36"
Case 25: Msg = "RS-232C"
Case 26: Msg = "RS-422"
Case 27: Msg = "RS-423"
Case 28: Msg = "RS-485"
Case 29: Msg = "RS-449"
Case 30: Msg = "V.35"
Case 31: Msg = "X.21"
Case 32: Msg = "IEEE-488"
Case 33: Msg = "AUI"
Case 34: Msg = "UTP Category 3"
Case 35: Msg = "UTP Category 4"
Case 36: Msg = "UTP Category 5"
Case 37: Msg = "BNC"
Case 38: Msg = "RJ11"
Case 39: Msg = "RJ45"
Case 40: Msg = "Fiber MIC"
Case 41: Msg = "Apple AUI"
Case 42: Msg = "Apple GeoPort"
Case 43: Msg = "PCI"
Case 44: Msg = "ISA"
Case 45: Msg = "EISA"
Case 46: Msg = "VESA"
Case 47: Msg = "PCMCIA"
Case 48: Msg = "PCMCIA Type I"
Case 49: Msg = "PCMCIA Type II"
Case 50: Msg = "PCMCIA Type III"
Case 51: Msg = "ZV Port"
Case 52: Msg = "CardBus"
Case 53: Msg = "USB"
Case 54: Msg = "IEEE 1394"
Case 55: Msg = "HIPPI"
Case 56: Msg = "HSSDC (6 pins)"
Case 57: Msg = "GBIC"
Case 58: Msg = "DIN"
Case 59: Msg = "Mini-DIN"
Case 60: Msg = "Micro-DIN"
Case 61: Msg = "PS/2"
Case 62: Msg = "Infrared"
Case 63: Msg = "HP-HIL"
Case 64: Msg = "Access.bus"
Case 65: Msg = "NuBus"
Case 66: Msg = "Centronics"
Case 67: Msg = "Mini-Centronics"
Case 68: Msg = "Mini-Centronics Type-14"
Case 69: Msg = "Mini-Centronics Type-20"
Case 70: Msg = "Mini-Centronics Type-26"
Case 71: Msg = "Bus Mouse"
Case 72: Msg = "ADB"
Case 73: Msg = "AGP"
Case 74: Msg = "VME Bus"
Case 75: Msg = "VME64"
Case 76: Msg = "Proprietary"
Case 77: Msg = "Proprietary Processor Card Slot"
Case 78: Msg = "Proprietary Memory Card Slot"
Case 79: Msg = "Proprietary I/O Riser Slot"
Case 80: Msg = "PCI-66MHZ"
Case 81: Msg = "AGP2X"
Case 82: Msg = "AGP4X"
End Select
Next capcount
wmiSystemSlotInfo = wmiSystemSlotInfo & Msg & vbTab
wmiSystemSlotInfo = wmiSystemSlotInfo & vbCrLf
Next obj
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
Public Function wmiComputerSystemInfo()Function wmiComputerSystemInfo() As String
Dim ComputerSystemSet As SWbemObjectSet
Dim Css As SWbemObject
Dim Thiscol As Long
Dim Msg As String
Dim Cnt As Long
On Error Resume Next
Set ComputerSystemSet = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_ComputerSystem")
wmiComputerSystemInfo = wmiComputerSystemInfo & "WMI ComputerSystem Property" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "AdminPasswordStatus" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "AutomaticResetBootOption" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "AutomaticResetCapability" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "BootROMSupported" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "BootupState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Caption" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ChassisBootupState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "CurrentTimeZone" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "DaylightInEffect" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Description" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Domain" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "DomainRole" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "EnableDaylightSavingsTime" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "FrontPanelResetStatus" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "InfraredSupported" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "KeyboardPasswordStatus" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Manufacturer" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Model" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Name" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "NetworkServerModeEnabled" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "NumberOfProcessors" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PartOfDomain" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PauseAfterReset" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PowerOnPasswordStatus" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PowerState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PowerSupplyState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "PrimaryOwnerName" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ResetCapability" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ResetCount" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ResetLimit" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Status" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "SystemStartupDelay" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "SystemStartupSetting" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "SystemType" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "ThermalState" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "TotalPhysicalMemory" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "UserName" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "WakeUpType" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "SystemStartupOptions" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & "Roles" & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & vbCrLf
For Each Css In ComputerSystemSet
Select Case Css.AdminPasswordStatus
Case 0: Msg = "Disabled"
Case 1: Msg = "Enabled"
Case 2: Msg = "Not Implemented"
Case 3: Msg = "Unknown"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Name & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.AutomaticResetBootOption & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.AutomaticResetCapability & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.BootROMSupported & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.BootupState & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Caption & vbTab
Select Case Css.ChassisBootupState
Case 1: Msg = "Other"
Case 2: Msg = "Unknown"
Case 3: Msg = "Safe"
Case 4: Msg = "Warning"
Case 5: Msg = "Critical"
Case 6: Msg = "Non-recoverable"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.CurrentTimeZone & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.DaylightInEffect & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Description & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Domain & vbTab
Select Case Css.DomainRole
Case 0: Msg = "Standalone Workstation"
Case 1: Msg = "Member Workstation"
Case 2: Msg = "Standalone Server"
Case 3: Msg = "Member Server"
Case 4: Msg = "Backup Domain Controller"
Case 5: Msg = "Primary Domain Controller"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.EnableDaylightSavingsTime & vbTab
Select Case Css.FrontPanelResetStatus
Case 0: Msg = "Disabled"
Case 1: Msg = "Enabled"
Case 2: Msg = "Not Implemented"
Case 3: Msg = "Unknown"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.InfraredSupported & vbTab
Select Case Css.KeyboardPasswordStatus
Case 0: Msg = "Disabled"
Case 1: Msg = "Enabled"
Case 2: Msg = "Not Implemented"
Case 3: Msg = "Unknown"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Manufacturer & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Model & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Name & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.NetworkServerModeEnabled & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.NumberOfProcessors & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.PartOfDomain & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.PauseAfterReset & vbTab
Select Case Css.PowerOnPasswordStatus
Case 0: Msg = "Disabled"
Case 1: Msg = "Enabled"
Case 2: Msg = "Not Implemented"
Case 3: Msg = "Unknown"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
Select Case Css.PowerState
Case 0: Msg = "Unknown"
Case 1: Msg = "Full Power"
Case 2: Msg = "Power Save - Low Power Mode"
Case 3: Msg = "Power Save - Standby"
Case 4: Msg = "Power Save - Unknown"
Case 5: Msg = "Power Cycle"
Case 6: Msg = "Power Off"
Case 7: Msg = "Power Save - Warning"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
Select Case Css.PowerSupplyState
Case 1: Msg = "Other"
Case 2: Msg = "Unknown"
Case 3: Msg = "Save"
Case 4: Msg = "Warning"
Case 5: Msg = "Critical"
Case 6: Msg = "Non-recoverable"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.PrimaryOwnerName & vbTab
Select Case Css.ResetCapability
Case 1: Msg = "Other"
Case 2: Msg = "Unknown"
Case 3: Msg = "Disabled"
Case 4: Msg = "Enabled"
Case 5: Msg = "Non-recoverable"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.ResetCount & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.ResetLimit & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.Status & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.SystemStartupDelay & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.SystemStartupSetting & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.SystemType & vbTab
Select Case Css.ThermalState
Case 1: Msg = "Other"
Case 2: Msg = "Unknown"
Case 3: Msg = "Safe"
Case 4: Msg = "Warning"
Case 5: Msg = "Critical"
Case 6: Msg = "Non-recoverable"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & FormatNumber(Css.TotalPhysicalMemory, 0) & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & Css.UserName & vbTab
Select Case Css.WakeUpType
Case 0: Msg = "Reserved"
Case 1: Msg = "Other"
Case 2: Msg = "Unknown"
Case 3: Msg = "APM Timer"
Case 4: Msg = "Modem Ring"
Case 5: Msg = "LAN Remote"
Case 6: Msg = "Power Switch"
Case 7: Msg = "PCI PME#"
Case 8: Msg = "AC Power Restored"
Case Else: Msg = ""
End Select
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
Msg = ""
For Cnt = LBound(Css.SystemStartupOptions) To UBound(Css.SystemStartupOptions)
Msg = Msg & Css.SystemStartupOptions(Cnt) & "-And-"
Next Cnt
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
Msg = ""
For Cnt = LBound(Css.Roles) To UBound(Css.Roles)
Msg = Msg & Css.Roles(Cnt) & "-And-"
Next Cnt
wmiComputerSystemInfo = wmiComputerSystemInfo & Msg & vbTab
wmiComputerSystemInfo = wmiComputerSystemInfo & vbCrLf
Next Css
End Function
'--end block--'
'***********************************************************************************************
'***********************************************************************************************
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- VB WMI 对象的示例代码
- SqlDataAdapter对象代码示例
- javascript客户端遍历控件与获取父容器对象示例代码
- PHP程序中使用PDO对象实现对数据库的增删改查操作的示例代码
- Jquery操作js数组及对象示例代码
- PHP程序中使用PDO对象实现对数据库的增删改查操作的示例代码
- .NET core高性能对象转换示例代码
- python面向对象代码示例
- 为Javascript中的String对象添加去除左右空格的方法(示例代码)
- 阿里云对象存储OSS配置介绍设置，上传代码示例
- 获得Javascript对象属性个数的示例代码
- JS动态添加与删除select中的Option对象(示例代码)
- Jquery获取元素的父容器对象示例代码
- 编程更改文本对象示例代码
- Javascript 修改String 对象 增加去除空格功能(示例代码)
- php示例代码之使用mysqli对象
- 演示Session对象使用 范例(示例代码下载)
- Flex之共享对象 ------ 示例代码演示
- JS动态添加与删除select中的Option对象(示例代码)
- python面向对象代码示例