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

VB6获取电脑硬件信息

编程学习2022-02-1439180


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
分享给朋友:

相关文章

代码迷惑技术如何保护Java免遭逆向工程

代码迷惑技术如何保护Java免遭逆向工程

很少有问题比程序员遇到不访问无法利用的源代码就无法解决的漏洞更令人沮丧的了。你是否在通过一个在线开源库修补代码,或正在调用常用操作系统例行程序;你可能每周都要花时间处理不是由你编写,因而也无法访问其源代码的代码。因为Java字节码包含许多和原始代码相同的信息,所以很容易对Java类文件执行逆向工程。另外,Java程度以其“一旦编写,随处运行”特性而闻名。虽然并非Java语言的专利,但代码反编译从未在Java开发者之中得到如此公开或普遍地利用。反编译的对...

致面向对象技术初学者的一封公开信

致面向对象技术初学者的一封公开信

 致面向对象技术初学者的一封公开信 Alistair Cockburn 著(1996 年2 月),袁峰 译介绍 首先我要解释一下为什么会写这封公开信。这似乎已经成了一种习惯,但这个步骤还是需要的。过去6 年中, 我曾经无数次地在饭店、酒吧、旅店大厅等各种地方以同一种方式度过愉快而漫长的夜晚:和同样追求真理、光明和智慧的伙伴一起探讨面向对象的真谛。现在,我已经可以回答很多当年我遇到的问题。这些同样的问题也在困扰着我的一位新同事,在一家饭店里,我花了整整一个晚上和他讨...

计算机蓝屏代码的含义

计算机蓝屏代码的含义

0 0x0000 作业完成。1 0x0001 不正确的函数。2 0x0002 系统找不到指定的档案。3 0x0003 系统找不到指定的路径。4 0x0004 系统无法开启档案。5 0x0005 拒绝存取。6 0x0006 无效的代码。7 0x0007 储存体控制区块已毁。8 0x0008 储存体空间不足,无法处理这个指令。9 0x0009 储存体控制区块地址无效。10 0x000A 环境不正确。11 0x000B 尝试加载一个格式错误的程序。12 0x000C 存取码错误。1...

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...

发表评论

访客

看不清,换一张

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