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

VB6获取电脑硬件信息

编程学习2022-02-143240


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


看效果


GetPCInfo.png




上代码


'获取系统信息
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
分享给朋友:

相关文章

关于学习编程和C语言

关于学习编程和C语言

关于学习编程和C语言  转自 开复网 Q:该怎么学习编程?  A:首先问你一个问题:你们在学校都学些什么课程? 问这个问题的原因是,我认为学校的计算机科学基础课很重要。如果你所在学校的课程设置合理,那你应该先把主要精力花在这些基础课上。很多学生看到基础理论就茫然,不知道这些图表,符号,甚至硬件的知识对将来的软件开发有什么用。用处大得很哪。比如,操作系统课里讲到的多线程的东西在系统编程里很有用。又比如,尽管你将来不会去涉及电脑的...

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

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

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

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

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

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

ASP六大对象介绍

ASP六大对象介绍

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

发表评论

访客

看不清,换一张

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