当前位置:首页 > 编程学习 > VB6获取电脑硬件信息

VB6获取电脑硬件信息

编程学习2022-02-1414830


VB6通过WIMI获取电脑硬件信息,可以查看电脑硬件配置信息。


看效果


GetPCInfo.png VB6获取电脑硬件信息  编程 技术 VB 第1张




上代码


'获取系统信息
Private Function getSysInfo()
    Dim Info, System, item

    Set System = GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
    For Each item In System
        Info = "计算机名称: " & item.Name & vbCrLf
        Info = Info & "状态: " & item.Status & vbCrLf
        Info = Info & "类型: " & item.SystemType & vbCrLf
        Info = Info & "生产厂家: " & item.Manufacturer & vbCrLf
        Info = Info & "型号: " & item.Model & vbCrLf
        'info = info & "内存: ~" & item.totalPhysicalMemory \ 1024000 & "MB" & vbCrLf
        Info = Info & "域: " & item.domain & vbCrLf
        Info = Info & "工作组" & item.Workgroup & vbCrLf '获得工作组和域的选项不能同时用
        Info = Info & "当前用户: " & item.username & vbCrLf
        Info = Info & "启动状态" & item.BootupState & vbCrLf
        Info = Info & "该计算机属于" & item.PrimaryOwnerName & vbCrLf
        Info = Info & "系统类型" & item.CreationClassName & vbCrLf
        Info = Info & "计算机类类型" & item.Description & vbCrLf
    
    Next
    getSysInfo = Info
End Function

'获取硬件信息
Public Function getPCInfo()
    On Error Resume Next
    Dim Info

    Set wshshell = CreateObject("wscript.shell")
    wshshell.run ("%comspec% /c net start winmgmt"), 0 '启动服务
    Set WshNetwork = CreateObject("WScript.Network")
    computername = WshNetwork.computername
    Info = "计算机名:" & computername & vbCrLf & vbCrLf

    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

    '主板
    Set board = objWMIService.ExecQuery("select * from win32_baseboard")
    For Each item In board
     board2 = board2 & item.Product & vbCrLf
    Next
    Info = Info & "主板:" & vbCrLf & board2 & vbCrLf

    'CPU
    Set cpu = objWMIService.ExecQuery("select * from win32_processor")
    For Each item In cpu
     cpu2 = cpu2 & item.Name & vbCrLf
    Next
    Info = Info & "CPU:" & vbCrLf & cpu2 & vbCrLf

    '内存
    Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory", , 48)
    Dim memory1
    For Each objItem In colItems
     a = objItem.capacity / 1048576
     temp = temp + Val(objItem.capacity)
     If InStr(memory1, "1条" & a & "M") <> 0 Then
         memory1 = Replace(memory1, "1条" & a & "M", "2条" & a & "M")
     ElseIf InStr(memory1, "2条" & a & "M") <> 0 Then
         memory1 = Replace(memory1, "2条" & a & "M", "3条" & a & "M")
     ElseIf InStr(memory1, "3条" & a & "M") <> 0 Then
         memory1 = Replace(memory1, "3条" & a & "M", "4条" & a & "M")
     Else
         memory1 = memory1 & "1条" & a & "M"
     End If
     n = n + 1
    Next
    memory = temp / 1048576
    If n = 1 Then
     memory2 = memory1
    Else
     memory2 = memory1 & " 总计" & memory & "M"
    End If
    Info = Info & "内存:" & vbCrLf & memory2 & vbCrLf & vbCrLf

    '硬盘
    Set disk = objWMIService.ExecQuery("select * from win32_diskdrive")
    For Each item In disk
     disk2 = disk2 & item.Model & vbCrLf
    Next
    Info = Info & "硬盘:" & vbCrLf & disk2 & vbCrLf

    '显卡
    Set video = objWMIService.ExecQuery("select * from win32_videocontroller", , 48)
    For Each item In video
     video2 = video2 & item.Description & vbCrLf
    Next
    Info = Info & "显卡:" & vbCrLf & video2 & vbCrLf

    '网卡
    Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter", , 48)
    For Each objItem In colItems
         lan2 = lan2 & objItem.Name & vbCrLf
    Next
    Info = Info & "网卡:" & vbCrLf & lan2 & vbCrLf
    getPCInfo = Info
End Function


'获取CPU信息
Private Function getCPUInfo()
    Dim CPUs()
    
    n = 0
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor", , 48)
    
    For Each objItem In colItems
    
        ReDim Preserve CPUs(n)
        
        CPUs(n) = "CPU信息如下:" & vbCrLf
        CPUs(n) = CPUs(n) & "处理器位数: " & objItem.AddressWidth & "位" & vbCrLf
        
        If objItem.Architecture = 0 Then
            CPUs(n) = CPUs(n) & "平台的处理器的设计:X86 " & vbCrLf
        ElseIf objItem.Architecture = 1 Then
            CPUs(n) = CPUs(n) & "平台的处理器的设计:MIPS " & vbCrLf
        ElseIf objItem.Architecture = 2 Then
            CPUs(n) = CPUs(n) & "平台的处理器的设计:Alpha " & vbCrLf
        ElseIf objItem.Architecture = 3 Then
            CPUs(n) = CPUs(n) & "平台的处理器的设计:PowerPC " & vbCrLf
        Else
            CPUs(n) = CPUs(n) & "平台的处理器的设计:ia64 " & vbCrLf
        End If
        
        CPUs(n) = CPUs(n) & "用性和状态: " & runState(objItem.Availability) & vbCrLf
        CPUs(n) = CPUs(n) & "标签: " & objItem.Caption & vbCrLf
        CPUs(n) = CPUs(n) & "管理程序错误编码: " & objItem.ConfigManagerErrorCode & vbCrLf
        CPUs(n) = CPUs(n) & "是否使用用户定义的配置: " & objItem.ConfigManagerUserConfig & vbCrLf
        CPUs(n) = CPUs(n) & "处理器的当前状态: " & objItem.CpuStatus & vbCrLf
        CPUs(n) = CPUs(n) & "创建范例类别的名称: " & objItem.CreationClassName & vbCrLf
        CPUs(n) = CPUs(n) & "当前速度: " & objItem.CurrentClockSpeed & "HZ" & vbCrLf
        CPUs(n) = CPUs(n) & "处理器的电压: " & objItem.CurrentVoltage & "V" & vbCrLf
        CPUs(n) = CPUs(n) & "处理器数据宽度: " & objItem.DataWidth & "位" & vbCrLf
        CPUs(n) = CPUs(n) & "描述: " & objItem.Description & vbCrLf
        CPUs(n) = CPUs(n) & "DeviceID: " & objItem.DeviceID & vbCrLf
        CPUs(n) = CPUs(n) & "错误是否已经清除: " & objItem.ErrorCleared & vbCrLf
        CPUs(n) = CPUs(n) & "错误描述: " & objItem.ErrorDescription & vbCrLf
        CPUs(n) = CPUs(n) & "外部时钟频率: " & objItem.ExtClock & vbCrLf
        CPUs(n) = CPUs(n) & "处理器系列类型: " & objItem.Family & vbCrLf
        CPUs(n) = CPUs(n) & "安装日期: " & objItem.InstallDate & vbCrLf
        CPUs(n) = CPUs(n) & "2 级高速缓存的大小: " & objItem.L2CacheSize & vbCrLf
        CPUs(n) = CPUs(n) & "2 级高速缓存的速度: " & objItem.L2CacheSpeed & vbCrLf
        CPUs(n) = CPUs(n) & "最后一次出错代码: " & objItem.LastErrorCode & vbCrLf
        CPUs(n) = CPUs(n) & "处理器类型.Level: " & objItem.Level & vbCrLf
        CPUs(n) = CPUs(n) & "处理器在最后一秒钟内的负载能量: " & objItem.LoadPercentage & vbCrLf
        CPUs(n) = CPUs(n) & "制造商: " & objItem.Manufacturer & vbCrLf
        CPUs(n) = CPUs(n) & "最大时钟频率: " & objItem.MaxClockSpeed & vbCrLf
        CPUs(n) = CPUs(n) & "名称: " & objItem.Name & vbCrLf
        CPUs(n) = CPUs(n) & "内核总数: " & objItem.NumberOfCores & vbCrLf
        CPUs(n) = CPUs(n) & "逻辑处理器数: " & objItem.NumberOfLogicalProcessors & vbCrLf
        CPUs(n) = CPUs(n) & "其他描述: " & objItem.OtherFamilyDescription & vbCrLf
        CPUs(n) = CPUs(n) & "逻辑设备的 Win32 即插即用设备 ID: " & objItem.PNPDeviceID & vbCrLf
        CPUs(n) = CPUs(n) & "电源的功能: " & objItem.PowerManagementCapabilities & vbCrLf
        CPUs(n) = CPUs(n) & "PowerManagementSupported: " & objItem.PowerManagementSupported & vbCrLf
        CPUs(n) = CPUs(n) & "ProcessorId: " & objItem.ProcessorId & vbCrLf
        CPUs(n) = CPUs(n) & "ProcessorType: " & objItem.ProcessorType & vbCrLf
        CPUs(n) = CPUs(n) & "版本: " & objItem.Revision & vbCrLf
        CPUs(n) = CPUs(n) & "Role: " & objItem.Role & vbCrLf
        CPUs(n) = CPUs(n) & "芯片插槽种类: " & objItem.SocketDesignation & vbCrLf
        CPUs(n) = CPUs(n) & "状态: " & objItem.Status & vbCrLf
        CPUs(n) = CPUs(n) & "StatusInfo: " & objItem.StatusInfo & vbCrLf
        CPUs(n) = CPUs(n) & "修改等级: " & objItem.Stepping & vbCrLf
        CPUs(n) = CPUs(n) & "作用系统的创建类名: " & objItem.SystemCreationClassName & vbCrLf
        CPUs(n) = CPUs(n) & "系统名: " & objItem.SystemName & vbCrLf
        CPUs(n) = CPUs(n) & "UniqueId: " & objItem.UniqueId & vbCrLf
        CPUs(n) = CPUs(n) & "CPU 插座信息: " & objItem.UpgradeMethod & vbCrLf
        CPUs(n) = CPUs(n) & "修订版号: " & objItem.Version & vbCrLf
        CPUs(n) = CPUs(n) & "处理器的电压能量: " & objItem.VoltageCaps & vbCrLf
        n = n + 1
    Next
    
    Dim str
    str = ""
    For i = 0 To n - 1
        str = str & CPUs(i)
    Next
    getCPUInfo = str
End Function

Function runState(a)
    Select Case a
        Case 3
        runState = "设备正在运行并且拥有全部能量"
        Case 4
        runState = "警告!"
        Case 5
        runState = "测试"
        Case 10
        runState = "降低"
        Case 13
        runState = "节能.未知:设备处于节能模式,但是该设备在这个模式中的准确状态未知"
        Case 14
        runState = "节能.降低:设备处于节能模式,但是仍旧运行并且反映出降低的功能"
        Case 15
        runState = "待机:设备没有在运行,但是可以“快速”进入全能状态"
        Case 17
        runState = "节能。警告:设备虽然处于警告状态,但是还处于节能状态"
        Case Else
        runState = "未知"
    End Select
End Function

Private Sub Command1_Click()
    Text1.Text = getSysInfo()
    Text2.Text = getPCInfo()
    Text3.Text = getCPUInfo()
End Sub






扫描二维码推送至手机访问。

版权声明:本文由海阔天空发布,如需转载请注明出处。

本文链接:https://www.apull.net/html/20220214180839.html

标签: 编程技术VB
分享给朋友:

相关文章

制作网页28个常用小代码

制作网页28个常用小代码

1、oncontextmenu="window.event.returnValue=false" 将彻底屏蔽鼠标右键<table border oncontextmenu=return(false)><td>no</table>  可用于Table2、<body onselectstart="return false"> 取消选取、防止复制3、onpaste="retu...

ASP六大对象介绍

ASP六大对象介绍

Application对象 Application对象是个应用程序级的对象,用来在所有用户间共享信息,并可以在Web应用程序运行期间持久地保持数据。 Application的属性:  方法如下: Application对象没有内置的属性,但是我们可以自行创建其属性。 <% Application("属性名")=值 %>    其实大部分Application变量都 存放在Contents集合中,当你创建一个新的Application变量时,其实...

HTML与ASCII码表

HTML与ASCII码表

HTML与ASCII码表Standard ASCII set, HTML Entity names, ISO 10646, ISO 8879, ISO 8859-1  Latin alphabet No. 1Browser support: All browsersASCIIHTMLHTMLDecHexSymbolNumberNameDescription32333435363738394041424344454647202122232425262728292A2B...

ASP错误提示大全

ASP错误提示大全

Microsoft VBScript 语法错误(0×800A03E9)–>内存不足Microsoft VBScript 语法错误(0×800A03EA)–>语法错误Microsoft VBScript 语法错误(0×800A03EB)–>缺少’:’Microsoft VBScript 语法错误(0×800A03ED)–>缺少’(’Mi...

发表评论

访客

看不清,换一张

◎欢迎参与讨论,请在这里发表您的看法和观点。