fox-info1.frm

VB获取硬件信息

        GlobalMemoryStatus MS
        totalpagingfilelbl.Caption = Format$(MS.dwTotalPageFile / 1024, "###,###,###,###") & " Kbyte"
        freepagingfilelbl.Caption = Format$(MS.dwAvailPageFile / 1024, "###,###,###,###") & " Kbyte"
        DXVERSIONlbl.Caption = GetDirectXVersion
        PRINTERA = ReadKey("HKEY_CURRENT_USER\Printers\DeviceOld")
        RProgramS = ReadKey("HKEY_CURRENT_USER\SessionInformation\ProgramCount")
        printerlbl.Caption = PRINTERA
        runningprogramslbl.Caption = RProgramS
        numberofprocessorslbl.Caption = Environ("Number_Of_Processors")
        systemdrivelbl.Caption = Environ("SystemDrive")
        RAMtimer.Enabled = True
        Dim os As OSVERSIONINFO
        Dim m As Long
        Dim mv As Long
        Dim pd As Long
        Dim miv As Long
        '--------------------
        Dim curDPS As DEVMODE
        Dim colors As String
        Dim SMR As Long
        
        SMR = EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, curDPS)
        
        If SMR = 0 Then
            ScreenResolutionLBL.Caption = "无法获取屏幕分辨率!"
        Else
            Select Case curDPS.dmBitsPerPel
                Case 4:      colors = "16 色"
                Case 8:      colors = "256 色"
                Case 16:     colors = "高彩色"
                Case 24, 32: colors = "真彩色"
            End Select
            ScreenResolutionLBL.Caption = Format(curDPS.dmPelsWidth, "@@@@") + " x " + _
                          Format(curDPS.dmPelsHeight, "@@@@") + "  " + _
                          Format(colors, "@@@@@@@@@@@@@  ") + _
                          Format(curDPS.dmDisplayFrequency, "@@@ Hz")
        End If
        '--------------------
        os.dwOSVersionInfoSize = Len(os)
        m = GetVersionEx(os)
        mv = os.dwMajorVersion
        pd = os.dwPlatformId
        miv = os.dwMinorVersion
        If pd = 2 Then WinOSlbl.Caption = "Windows NT" & " " & mv & "." & miv
        If pd = 1 Then
            If miv = 10 Then WinOSlbl.Caption = "Windows 98"
            If miv = 0 Then WinOSlbl.Caption = "Windows 95"
            If miv = 90 Then WinOSlbl.Caption = "Windows Me"
        End If
        PROCESSORSINFO = ReadKey("HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0\Processornamestring")
        processorlbl.Caption = PROCESSORSINFO
        wanIPADDRESSlbl.Caption = GetPublicIP()
    Case 2
        If lblCheckedHDSPACE.Caption = "0" Then
            FillListview
            lblCheckedHDSPACE.Caption = "1"
        Else
        End If
    Case 3
        processeslisting
    Case 4
        With ListView1
            .ListItems.Clear
            .ColumnHeaders.Clear
            .ColumnHeaders.Add , , "WMI 属性"
            .ColumnHeaders.Add , , "值"
            .View = lvwReport
            .Sorted = False
        End With
        Command3_Click
    End Select
End Sub

Sub processeslisting()
    '----------
    Dim header As ColumnHeader
    LvW.View = lvwReport
    LvW.ColumnHeaders.Clear
    Set header = LvW.ColumnHeaders.Add(, "first", "进程", LvW.Width / 4 * 3) '设置宽度
    Set header = LvW.ColumnHeaders.Add(, "second", "ID", LvW.Width - LvW.Width / 4 * 3)
    LvW.Refresh
    '----------
    Dim ret
    Dim TheLoopingProcess
    Dim proc As PROCESSENTRY32
    Dim snap As Long
    Dim exename As String
    LvW.ListItems.Clear '清空
    snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获取快照句柄
    proc.dwSize = Len(proc)
    TheLoopingProcess = ProcessFirst(snap, proc)
    Processeslbl.Caption = -1
    i = 0
    While TheLoopingProcess <> 0      '循环
        exename = proc.szExeFile
        ret = LvW.ListItems.Add(, "first" & CStr(i), exename)   '进程名称
        LvW.ListItems("first" & CStr(i)).SubItems(1) = proc.th32ProcessID   '进程ID
        Processeslbl.Caption = Processeslbl.Caption + 1
        i = i + 1
        TheLoopingProcess = ProcessNext(snap, proc)
    Wend
    CloseHandle snap
End Sub

Private Sub terminateprocess_Click()
    Dim i As Integer
    Dim Counter As Integer
    Dim lngSuccess As Long
    Dim dblPID As Double
    
    Counter = LvW.ListItems.Count
    For i = 1 To Counter
        With LvW.ListItems.Item(i)
            If .Selected = True Then
                KillProcessById (.SubItems(1))
            End If
        End With
    Next i
    processeslisting
    Timer2.Enabled = True
End Sub

Private Sub Timer1_Timer()
    Dim CpuValueCreating
    UpdateValues
    PB1.Value = Round(PB1.Value, 0)
    CPUPercentage.Left = Shape1.Left + Shape1.Width / 2 - CPUPercentage.Width / 2
    CPUPercentage.Top = Shape1.Top + Shape1.Height / 2 - CPUPercentage.Height / 2
    CPUPercentage.Caption = PB1.Value & "%"
    BARVALUE = PB1.Value
    CpuValueCreating = CPUpersonalBar(BARVALUE, CPUBAR)
End Sub

Public Function CPUpersonalBar(ProgressBarValue As Integer, ProgressBarName As Shape)
    ProgressBarName.Width = ProgressBarValue * 82.95 ' Write here the value for one percent
End Function

Public Function NameOfTheComputer(MachineName As String) As Long
    Dim NameSize As Long
    Dim X As Long
    MachineName = Space$(16)
    NameSize = Len(MachineName)
    X = GetComputerName(MachineName, NameSize)
End Function

Sub FillListview()
    On Error Resume Next
    Dim strDrive As String
    Dim strMessage As String
    Dim rtn
    Dim fs, H, s, bt As String
    Dim Check, Counter
    Dim varible, lWidth
    Dim a, b, C, n, d As String
    lvwHD.ListItems.Clear
    lWidth = lvwHD.Width / 5
    lvwHD.ColumnHeaders.Clear
    lvwHD.ColumnHeaders.Add , , "名称", lWidth
    lvwHD.ColumnHeaders.Add , , "类型", lWidth
    lvwHD.ColumnHeaders.Add , , "总计大小", lWidth
    lvwHD.ColumnHeaders.Add , , "剩余空间", lWidth
    lvwHD.ColumnHeaders.Add , , "使用空间", lWidth - 60
    lvwHD.View = lvwReport
    lvwHD.ListItems.Clear
    Check = True: Counter = 65
    For Counter = 67 To 86
        strDrive = Chr(Counter)
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set H = fs.GetDrive(fs.GetDriveName(strDrive + ":\"))
        Select Case GetDriveType(strDrive + ":\")
            Case DRIVE_FIXED
                If H.FreeSpace < 1024 ^ 3 Then
                    bt = " MB"
                    n = H.volumename & " (" & UCase(strDrive & "\:") & ")"
                    a = "本地磁盘"
                    b = Left(Format(H.TotalSize / 1048576, "#,##.00"), 3) & bt
                    C = Left(Format(H.FreeSpace / 1048576, "#,##.00"), 3) & bt
                ElseIf H.FreeSpace > 1024 ^ 3 Then
                    bt = " GB"
                    n = H.volumename & " (" & UCase(strDrive & ":") & ")"
                    a = "本地磁盘"
                    b = Left(Format(H.TotalSize / 1071576, "#,##.00"), 4) & bt
                    C = Left(Format(H.FreeSpace / 1071576, "#,##.00"), 4) & bt
                End If
                k = H.TotalSize - H.FreeSpace
                If k < 1024 ^ 3 Then
                    If k < 1024 ^ 2 Then
                        bt = " KB"
                        k = H.TotalSize - H.FreeSpace
                        d = Left(Format(k / 1024, "#,##.00"), 4) & bt
                    Else
                        bt = " MB"
                        k = H.TotalSize - H.FreeSpace
                        d = Left(Format(k / 1048576, "#,##.00"), 3) & bt
                    End If
                ElseIf k > 1024 ^ 3 Then
                    bt = " GB"
                    k = H.TotalSize - H.FreeSpace
                    d = Left(Format(k / 1071576, "#,##.00"), 4) & bt
                End If
                Set varible = lvwHD.ListItems.Add(, , n)
                varible.SubItems(1) = a
                varible.SubItems(2) = b
                varible.SubItems(3) = C
                varible.SubItems(4) = d
                i = i + H.TotalSize
                j = j + H.FreeSpace
                L = L + k
                rtn = "本地磁盘"
            Case DRIVE_REMOTE
                rtn = "物理驱动器"
            Case DRIVE_CDROM
                rtn = "CD-ROM"
            Case DRIVE_RAMDISK
                rtn = "移动磁盘"
            Case Else
                rtn = ""
        End Select
    Next Counter
    Set varible = lvwHD.ListItems.Add(, , "-----------------")
    varible.SubItems(1) = "-----------------"
    varible.SubItems(2) = "-----------------"
    varible.SubItems(3) = "-----------------"
    varible.SubItems(4) = "-----------------"
    Set varible = lvwHD.ListItems.Add(, , "总计")
    varible.SubItems(1) = lvwHD.ListItems.Count - 2 & " 本地硬盘"
    varible.SubItems(2) = Left(Format(i / 1071576, "#,##.00"), 5) & " GB"
    varible.SubItems(3) = Left(Format(j / 1071576, "#,##.00"), 5) & " GB"
    varible.SubItems(4) = Left(Format(L / 1071576, "#,##.00"), 5) & " GB"
    lvwHD.FlatScrollBar = False
End Sub

Private Sub Timer2_Timer()
    processeslisting
    Timer2.Enabled = False
End Sub
 
Function GetDirectXVersion() As String
    Dim handle As Long
    
    Dim resString As String
    Dim strVersion As String
    
    Dim resBinary() As Byte
      
    If RegOpenKeyEx(&H80000002, "SOFTWARE\Microsoft\DirectX", 0, &H20019, handle) Then Exit Function
      
    ReDim resBinary(1023) As Byte
      
    Call RegQueryValueEx(handle, "Version", 0, 0, resBinary(0), 1024)
      
    resString = Space$(1023)
    CopyMemory ByVal resString, resBinary(0), 1023
      
    RegCloseKey handle
      
    resString = Left(resString, 12)
      
    Select Case resString
        Case "4.02.0095"
            GetDirectXVersion = "1.0"
        Case "4.03.00.1096"
            GetDirectXVersion = "2.0"
        Case "4.04.0068", "4.04.0069"
            GetDirectXVersion = "3.0"
        Case "4.05.00.0155"
            GetDirectXVersion = "5.0"
        Case "4.05.01.1721", "4.05.01.1998"
            GetDirectXVersion = "5.0"
        Case "4.06.02.0436"
            GetDirectXVersion = "6.0"
        Case "4.07.00.0700"
            GetDirectXVersion = "7.0"
        Case "4.07.00.0716"
            GetDirectXVersion = "7.0a"
        Case "4.08.00.0400"
            GetDirectXVersion = "8.0"
        Case "4.08.01.0881", "4.08.01.0810"
            GetDirectXVersion = "8.1"
        Case "4.09.0000.0900"
            GetDirectXVersion = "9.0"
        Case "4.09.0000.0901"
            GetDirectXVersion = "9.0a"
        Case "4.09.0000.0902"
            GetDirectXVersion = "9.0b"
        Case "4.09.00.0904"
            GetDirectXVersion = "9.0c"
    End Select
  
End Function

'自动缩放listview宽度
Private Sub lvAutosizeControl(lv As ListView)
   Dim col2adjust As Long
   For col2adjust = 0 To lv.ColumnHeaders.Count - 1
      Call SendMessage(lv.hwnd, _
                       LVM_SETCOLUMNWIDTH, _
                       col2adjust, _
                       ByVal LVSCW_AUTOSIZE_USEHEADER)
   Next
End Sub

Private Sub wmiBiosInfo()
   Dim BiosSet As SWbemObjectSet
   Dim bios As SWbemObject
   Dim itmx As ListItem
   Dim cnt As Long
   Dim msg As String
   
   Set BiosSet = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
                                      InstancesOf("Win32_BIOS")
   
   On Local Error Resume Next
   
   For Each bios In BiosSet
   
'      Set itmx = ListView1.ListItems.Add(, , "主BIOS")
'      itmx.SubItems(1) = bios.PrimaryBIOS
            
'      Set itmx = ListView1.ListItems.Add(, , "状态")
'      itmx.SubItems(1) = bios.Status
      
'      For cnt = LBound(bios.BIOSVersion) To UBound(bios.BIOSVersion)
'         Set itmx = ListView1.ListItems.Add(, , IIf(cnt = 0, "BIOS版本字符", ""))
'         itmx.SubItems(1) = bios.BIOSVersion(cnt)
'      Next
      
'      Set itmx = ListView1.ListItems.Add(, , "Caption")
'      itmx.SubItems(1) = bios.Caption
      
'      Set itmx = ListView1.ListItems.Add(, , "描述")
'      itmx.SubItems(1) = bios.Description
      
      Set itmx = ListView1.ListItems.Add(, , "名称")
      itmx.SubItems(1) = bios.Name

      Set itmx = ListView1.ListItems.Add(, , "制造商")
      itmx.SubItems(1) = bios.Manufacturer

      Set itmx = ListView1.ListItems.Add(, , "最终版本")
      itmx.SubItems(1) = bios.ReleaseDate

'      Set itmx = ListView1.ListItems.Add(, , "序列号")
'      itmx.SubItems(1) = bios.SerialNumber

      Set itmx = ListView1.ListItems.Add(, , "SMBIOSBIOSVersion")
      itmx.SubItems(1) = bios.SMBIOSBIOSVersion
      
      Set itmx = ListView1.ListItems.Add(, , "SMBIOSMajorVersion")
      itmx.SubItems(1) = bios.SMBIOSMajorVersion