pcl_test

Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
Set fso = CreateObject("Scripting.FileSystemObject")

'第一部分：显示“系统相关信息”
Set wmiObjects = wmiService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each wmiObject In wmiObjects
    caption=wmiObject.Caption
    version=wmiObject.Version
    osarchitecture=wmiObject.OSArchitecture
    installdate=wmiObject.InstallDate
    lastbootuptime=wmiObject.LastBootUpTime
Next

'第二部分：显示“计算机名”
Set colSettings = wmiService.ExecQuery("Select * from Win32_ComputerSystem")
For Each objComputer in colSettings
    computername=objComputer.Name
Next

'第三部分：显示“IP、MAC地址”
Set colItems = wmiService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objItem in colItems
    For Each objAddress in objItem.IPAddress
      If objAddress <> "" then
          ipaddress=objAddress 
          macaddress=objItem.MACAddress
      Exit For
      End If
    Next
    Exit For
Next

'第四部分：查看系统ID、密钥
Set WshShell = CreateObject("WScript.Shell")
regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
DigitalProductId = WshShell.RegRead(regKey & "DigitalProductId")

productid = WshShell.RegRead(regKey & "ProductID")
productkey = ConvertToKey(DigitalProductId)

'输出
file ="系统信息.txt"
info = "系统："& caption &" "& osarchitecture _
    & vbCrLf &"版本：" & version _
    & vbCrLf &"计算机名：" & computername _
    & vbCrLf &"安装时间："& FormatDT(installdate) _
    & vbCrLf &"最后启动："& FormatDT(lastbootuptime) _
    & vbCrLf &"IP地址："& ipaddress _
    & vbCrLf &"MAC地址："& macaddress _
    & vbCrLf &"产品ID："& productid _
    & vbCrLf &"产品密钥："& productkey

IF msgbox(info &vbCrLf&vbCrLf&"是否保存以上信息到文本文件 "& file &"？", vbYesNo, "系统信息")=6 Then
    fso.OpenTextFile(file, 2, true).Write info
End If
WSH.quit

Function ConvertToKey(regKey)
    Const KeyOffset = 52
    isWin8 = (regKey(66) \ 6) And 1
    regKey(66) = (regKey(66) And &HF7) Or ((isWin8 And 2) * 4)
    j = 24
    Chars = "BCDFGHJKMPQRTVWXY2346789"
    Do
        Cur = 0
        y = 14
        Do
            Cur = Cur * 256
            Cur = regKey(y + KeyOffset) + Cur
            regKey(y + KeyOffset) = (Cur \ 24)
            Cur = Cur Mod 24
            y = y -1
        Loop While y >= 0
        j = j -1
        winKeyOutput = Mid(Chars, Cur + 1, 1) & winKeyOutput
        Last = Cur
    Loop While j >= 0
    If (isWin8 = 1) Then
        keypart1 = Mid(winKeyOutput, 2, Last)
        insert = "N"
        winKeyOutput = Replace(winKeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
        If Last = 0 Then winKeyOutput = insert & winKeyOutput
    End If
    a = Mid(winKeyOutput, 1, 5)
    b = Mid(winKeyOutput, 6, 5)
    c = Mid(winKeyOutput, 11, 5)
    d = Mid(winKeyOutput, 16, 5)
    e = Mid(winKeyOutput, 21, 5)
    ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function

'格式化日期时间
Function FormatDT(dt)
    FormatDT=left(dt, 4)&"-"&mid(dt, 5, 2)&"-"&mid(dt, 7, 2) _
        &" "&mid(dt, 9, 2)&":"&mid(dt, 11, 2)&":"&mid(dt, 13, 2)
End Function
复制代码

pcl_test

OSArchitecture表示系统位数32/64，不支持说明xp系统的Win32_OperatingSystem没有该属性

pcl_test

info = " 系统简易信息："& vbCrLf _
    & vbCrLf &"系统："& caption & osarchitecture _
    & vbCrLf &"版本：" & version _
    & vbCrLf &"计算机名：" & computername _
    & vbCrLf &"安装时间："& FormatDT(installdate) _
    & vbCrLf &"最后启动："& FormatDT(lastbootuptime) _
    & vbCrLf &"IP地址："& ipaddress _
    & vbCrLf &"MAC地址："& macaddress _
    & vbCrLf &"产品ID："& productid _
    & vbCrLf &"产品密钥："& productkey
复制代码

pcl_test

回复 9# doswork

Set fso = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("WScript.Shell")

'获取系统相关信息
Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
Set Items = wmiService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
For Each Item In Items
    caption=Item.Caption
    version=Item.Version
    installdate=Item.InstallDate
    lastbootuptime=Item.LastBootUpTime
Next

osinfo = "系统："& caption _
    & vbCrLf &"版本：" & version _
    & vbCrLf &"安装时间："& FormatDT(installdate) _
    & vbCrLf &"最后启动："& FormatDT(lastbootuptime)

'输出
outfile ="保存信息.txt"
allinfo = "msgbox并没有参数可设置对话框的大小或控制显示信息内容的多少。" _
    &vbCrLf& "可以调用hta实现自定义对话框，实际可把vbs代码写到hta里，" _
    &vbCrLf& "完全可做出一个带美观界面的桌面应用程序，结合css或js可玩性更高" _
    &vbCrLf&vbCrLf& osinfo & vbCrLf & vbCrLf & GetMemory()
    
ShowInfo(replace(allinfo,VbCrLf,"<br/>"))

'自定义对话框
Function ShowInfo(info)
    Set htafile = fso.OpenTextFile("$temp.hta",2,true)
    htafile.Write "<title>提示</title><script>" & _
        "window.resizeTo(600,600);" & _
        "function writetxt(){" & _
        "var txt=document.getElementById('info').innerText.replace(/<br\/>/g, '\r\n');" & _
        "(new ActiveXObject('Scripting.FileSystemObject')).OpenTextFile('"& outfile &"',2,true).write(txt);close();}" & _
        "</script><div>是否保存以下信息到文本文件&nbsp;<font color='#FF0000'>"& outfile &"</font>？" & _
        "<input type='button' value='是(Y)' onclick='writetxt()'>&nbsp;&nbsp;&nbsp;&nbsp;" & _
        "<input type='button' value='否(N)' onclick='window.close()'></div><br/><div id='info'><font style='font-weight:bold' color='#008200'>"& info &"</font></div>"
    htafile.Close
    shell.Run "$temp.hta", 1, True
    fso.DeleteFile "$temp.hta"
End Function

'格式化日期时间
Function FormatDT(dt)
    FormatDT=left(dt, 4)&"-"&mid(dt, 5, 2)&"-"&mid(dt, 7, 2) _
        &" "&mid(dt, 9, 2)&":"&mid(dt, 11, 2)&":"&mid(dt, 13, 2)
End Function

'内存信息
Function GetMemory()
    mtotal=0
    num=0
    s=""
    Set colMemory = wmiService.execquery("select * from win32_physicalmemory",,48)
    For Each objitem In colMemory
        mtotal = mtotal+objitem.capacity
        num = num + 1
        s=s&"内存"& num &"："&(objitem.capacity/1048576)&"M "
    Next  
    GetMemory="总计内存"& num & "条，共" & (mtotal/1048576) & "M " &s 
End Function 
复制代码

pcl_test

回复 11# doswork


10L已整合

pcl_test

回复 13# doswork

指定回应某楼层的在相应楼层点回复，少引用

测试没有问题

pcl_test

回复 15# doswork

ConvertToKey是个自定义函数，你不能把函数体给漏了，这种低级错误不该犯
Function ConvertToKey(regKey)
……
End Function

pcl_test

回复 18# doswork

最后一次
1、html中以 代表空格
& vbCrLf &"版      本： "& version  _ ……
& vbCrLf &"版    本： "& version  _ ……

2、出现内容叠加是因为你把上一次的结果也加进去了
Dx = Dx  & vbTab & oLD.DeviceID ……    Dx = oLD.DeviceID……
cx = cx & "【 硬盘 " & i &" 】  型号: "……    cx = "【 硬盘 " & i &" 】  型号: "……
如

for i=1 to 10
    a=i  '未叠加
    b=b&i  '叠加
    msgbox "a="&a&" b="&b
next
复制代码

pcl_test

回复 21# doswork

Set fso = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("WScript.Shell")

str="c: ntfs"&vbTab&"共：55 GB"&vbTab&"可用15 GB"&vbTab&"使用率 60%" _
    & vbCrLf &"d: ntfs"&vbTab&"共：95.512 GB"&vbTab&"可用15.512 GB"&vbTab&"使用率 60%" _
    & vbCrLf &"e: fat32"&vbTab&"共：95 GB"&vbTab&"可用1.5 GB"&vbTab&"使用率 2%"


outfile="outfile.txt"
msgbox(str)
ShowInfo(replace("方法一，表格<br/>"&formatTable(str), VbCrLf, "<br/>"))
ShowInfo(replace("方法二，按字段长度填充空格<br/>"&formatSpace(str), VbCrLf, "<br/>"))

'自定义对话框
Function ShowInfo(info)
    CreateObject("WScript.Shell").Exec("mshta.exe ""about:<hta:application showintaskbar=no />" &_
        "<title>提示</title><script>window.resizeTo(600, 600);" & _
        "function writetxt(){var txt=document.getElementById('info').innerText.replace(/<br\/>/g, '\r\n');" & _
        "(new ActiveXObject('Scripting.FileSystemObject')).OpenTextFile('"& outfile &"',2,true).write(txt);close();}</script>" & _
        "<body style='font-family:SimSun;'><div style='position:fixed;top:0;left:0;'>是否保存以下信息到文本文件&nbsp;<font style='color:#FF0000;'>"& outfile &"</font>？" & _
        "<input type='button' value='是(Y)' onclick='writetxt()'>&nbsp;&nbsp;&nbsp;&nbsp;" & _
        "<input type='button' value='否(N)' onclick='window.close()'></div><br/><div id='info'><font style='color:#008200;'>"& info &"</font></div></body>""").StdOut.ReadAll
End Function

'套入表格
Function formatTable(str)
    tr=split(str, vbCrLf)
    For i=0 to Ubound(tr)
        s=s&"<tr>"
        td = split(tr(i), vbTab)
        For j=0 to Ubound(td)
            s=s&"<td>"&td(j)&"</td>"
        Next
        s=s&"</tr>"
    Next
    formatTable="<table>"&s&"</table>"
End Function

'按字段长度填充空格
Function formatSpace(str)
    sp=Space(100)
    Set objDict = WSH.CreateObject("Scripting.Dictionary")
    tr=split(str, vbCrLf)
    For i=0 to Ubound(tr)
        td = split(tr(i), vbTab)
        For j=0 to Ubound(td)
            l=0
            n=0
            For k=1 to len(td(j))
                c=Asc(Mid(td(j), k, 1))
                If c>0 and c<127 Then
                    l = l+1
                Else
                    n = n+1
                    l = l+2
                End If
            Next
            If n>0 Then objDict.Add "#"&i&j, n
            If not objDict.Exists(j) Then
                objDict.Add j, l
            Else
                If l > CInt(objDict.Item(j)) Then objDict.Item(j)=l
            End If
        Next
    Next
    
    For i=0 to Ubound(tr)
        td = split(tr(i), vbTab)
        For j=0 to Ubound(td)-1
            If objDict.Exists("#"&i&j) Then
                s=s&replace(left(td(j)&sp, objDict.Item(j)-objDict.Item("#"&i&j)+3), " ", "&nbsp;")
            Else
                s=s&replace(left(td(j)&sp, objDict.Item(j)+3), " ", "&nbsp;")
            End If
        Next
        s=s&td(Ubound(td))&vbCrLf
    Next
    formatSpace=s
End Function
复制代码