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

VB6获取电脑硬件信息

编程学习2022-02-1439200


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://apull.net/html/20220214180839.html

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

相关文章

[转] 深入探讨C++中的引用

[转] 深入探讨C++中的引用

  摘要:介绍C++引用的基本概念,通过详细的应用分析与说明,对引用进行全面、透彻地阐述。  关键词:引用,const,多态,指针  引用是C++引入的新语言特性,是C++常用的一个重要内容之一,正确、灵活地使用引用,可以使程序简洁、高效。我在工作中发现,许多人使用它仅仅是想当然,在某些微妙的场合,很容易出错,究其原由,大多因为没有搞清本源。故在本篇中我将对引用进行详细讨论,希望对大家更好地理解和使用引用起到抛砖引玉的作用。  引用简介  引用就是某一变量(目标)的一个别名,...

VB.NET关于加密算法

VB.NET关于加密算法

加密将防止数据被查看或修改,并在原本不安全的信道上提供安全的通信信道,它达到以下目的:  保密性:防止用户的标识或数据被读取。  数据完整性:防止数据被更改。  身份验证:确保数据发自特定的一方。  基本概念  1、散列(HASH)函数  散列(HASH)函数H也称哈希函数或杂凑函数等,是典型的多到一的函数,其输入为一可变长x(可以足够的长),输出一固定长的串h(一般为128位、160位,比输入的串短),该串h被称为输入x的Hash值(或称消息摘要Message  ...

用vb模拟键盘

用vb模拟键盘

  键盘是我们使用计算机的一个很重要的输入设备了,即使在鼠标大行其道的今天,很多程序依然离不开键盘来操作。但是有时候,一些重复性的,很繁琐的键盘操作总会让人疲惫,于是就有了用程序来代替人们按键的方法,这样可以把很多重复性的键盘操作交给程序来模拟,省了很多精力,按键精灵就是这样的一个软件。那么我们怎样才能用VB来写一个程序,达到与按键精灵类似的功能呢?那就让我们来先了解一下windows中响应键盘事件的机制。   当用户按下键盘上的一个键时,键盘内的芯片会...

SetTimer(), KillTimer() 使用

SetTimer(), KillTimer() 使用

SetTimer函数的用法  1 )用WM_TIMER来设置定时器  先请看SetTimer这个API函数的原型  UINT_PTR SetTimer(   HWND hWnd, // 窗口句柄   UINT_PTR nIDEvent, // 定时器ID,多个定时器时,可以通过该ID判断是哪个定时器   UINT uElapse, // 时间间隔,单位为毫秒   TIMERPROC lpTimerFunc // 回调函数   );例如  SetTimer...

发表评论

访客

看不清,换一张

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