VB WMI 对象的示例代码

http://www.diybl.com/course/3_program/vb/2008331/107856.html

Attribute VB_Name  =   " ModuleWMI "
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--''
'
'***********************************************************************************************
'
'***********************************************************************************************
  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值