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

VB6获取电脑硬件信息

编程学习2022-02-148130


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

相关文章

SHFileOperation介绍

SHFileOperation介绍

SHFileOperation函数功能描述:文件操作,与 Shell 的动作相同.函数原型:#include<shellapi.h> WINSHELLAPI int WINAPI SHFileOperation(LPSHFILEOPSTRUCT lpFileOp);参数:typedef struct _SHFILEOPSTRUCT { HWND hwnd; //父窗口句柄 UINT wFu...

密码的故事

密码的故事

密码的故事Billy Hollis 本文是由一个问题引出的。我需要一种将密码保存在加密文件中的方法,因为我需要记住许多密码,但记忆力却已大不如前。我知道有许多商用工具能够做到这一点,但我感到学习  .NET 中的一项新技术真的很有好处。 我用 Visual Basic® .NET  完成了一个简单而完整的程序,用于加密和解密文件,从中学到了许多知识。既然加密对于多种开发都是一个重要问题,本文就介绍一下如何构造这样的程序。 有各种低级别的技术可以用于加密,...

VB/VB.net 只允许运行一个实例

VB/VB.net 只允许运行一个实例

VB/VB.net  只允许运行一个实例       by:  Apull  VB中的实现方法VB如何防止程序被重复加载,也就是只允许运行一个实例,一般有2种方法。一,直接用VB提供的APP对象的PrevInstance方法。PrevInstance的返回值为True则说明已经有一个实力在运行。If App.PrevInstance Then Msgbox "已经有一个实例在运行" End if这个...

计算机蓝屏代码的含义

计算机蓝屏代码的含义

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

发表评论

访客

看不清,换一张

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