[问题求助] [已解决]VBS如何实现同一对话框显示几段代码的执行结果并可选择是否输出结果到文本

doswork

网上不同地方找的代码，希望实现如下功能，帮忙看怎么整合到一起输出，多谢！

1、由于不同代码不同功能，输出是好几个界面，现希望将这几个功能的输出内容界面合并输出到一个界面来显示；
2、将最终合并输出的内容以文本方式写入当前目录下的output.txt，带（是/否 输出）选项。

k=1
Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
Set wmiObjects = wmiService.ExecQuery("SELECT * FROM Win32_OperatingSystem")

'第一部分：希望在一个界面输出显示的内容
For Each wmiObject In wmiObjects
    msgbox "系统"&k&vblf&"" _
 &vblf&"计算机名： 不知道在这里显示的代码" _
 &vblf&"WinProductID： 不知道在这里显示的代码" _
 &vblf&"" _
 &vblf&"系统版本： "&wmiObject.Caption _
 &vblf&"安装时间： "&wmiObject.InstallDate  _ 
 &vblf&"最后启动： "&wmiObject.lastbootuptime  _
 &vblf&"能不能让时间格式显示为：2016-05-05 21:08:55 ？" _
 &vblf&"" _
 &vblf&"ip地址： 不知道在这里显示的代码" _
 &vblf&"MAC地址： 不知道在这里显示的代码" 
next 

'第二部分：显示“计算机名”（如果 第一部分 可以实现显示的话，这里就不用了）
Set colSettings = wmiService.ExecQuery _
    ("Select * from Win32_ComputerSystem")
For Each objComputer in colSettings 
    Wscript.Echo "System Name: " & objComputer.Name

next 

'第三部分：显示“IP、MAC地址”（如果 第一部分 可以实现显示的话，这里就不用了）
Function GetIPMAC(ComputerName) 
Dim objWMIService,colItems,objItem,objAddress
Set objWMIService = GetObject("winmgmts://" & ComputerName & "/root/cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objItem in colItems
 For Each objAddress in objItem.IPAddress
  If objAddress <> "" then
  GetIPMAC = "IP 地址：  " & objAddress  & vbNewLine &  "MAC地址：  " & objItem.MACAddress
  Exit For
 End If  
 Next
 Exit For
Next
End Function

WScript.Echo GetIPMAC(".")

'第四部分：win10 序列号查看器（如果 第一部分 可以实现显示的话，这里就不用了）
Set WshShell = CreateObject("WScript.Shell")
regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
DigitalProductId = WshShell.RegRead(regKey & "DigitalProductId")

WinProductName = "Windows Product Name: " & WshShell.RegRead(regKey & "ProductName") & vbNewLine
WinProductID = "Windows Product ID: " & WshShell.RegRead(regKey & "ProductID") & vbNewLine
WinProductKey = ConvertToKey(DigitalProductId)
strProductKey ="Windows Key: " & WinProductKey 
WinProductID = WinProductName & WinProductID & strProductKey


MsgBox(WinProductID)


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
复制代码

doswork

回复 23# pcl_test


    非常感谢版主的帮助！   全部完工~

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
复制代码

doswork

回复 19# pcl_test


    您好版主，能再帮最后一个忙吗？
vbs转换成hta后的 不对齐 问题，上一楼 详述，十分感谢！

doswork

回复 19# pcl_test


    不好意思，还得请教版主最后一个小问题： 这小段儿代码怎么让取得的硬盘大小数字对齐？（18楼有相对完整代码）

   代码生成后的结果有 30 G 的，也有 30.5 G 的（取的是保留小数点后1位，如果保留3位，分行显示就乱，多块儿硬盘的就更乱了），查资料在这里不知道怎么套用……
如果取小数点后三位，显示效果：
第一行：   c: ntfs  共：55 GB    可用15 GB    使用率 60%
第二行：   d: ntfs  共：95.512 GB    可用15.512 GB    使用率 60%
   
查论坛找到最简洁的一段儿代码，但在这里好像不适合套用……
（思路知道是需要添加tab或空格，固定值可以操作，但这里是变量值还带公式，就不知道怎么处理了……）
尝试过加 & vbTab ，但在输出的 hta 中没有作用，不能对齐，单独的 msgbox 有效。
http://www.bathome.net/redirect. ... d=1246&pid=5946

                   For Each oLD In cLD
                     Dx = Dx _
                        & vbTab & oLD.DeviceID &" " & Left(oLD.VolumeName&"         " ,11) & Left(oLD.FileSystem&"   " ,6) & "共:" _
                        & Right("    "&Round(oLD.Size/1073741824,1),6)                &" GB    可用:" _
                        & Right("    "&Round(oLD.FreeSpace/1073741824,1),6)           &" GB    使用率:"_
			& CInt( (100*((oLD.Size-oLD.FreeSpace)/oLD.Size)) ) &"%"  & vbCrLf
					WriteTable "分区信息",dx  
                   Next
复制代码

doswork

回复 19# pcl_test


    非常感谢版主指点！
    目前的问题全部解决完毕~

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
复制代码

doswork

回复 10# pcl_test


    想完成自己做个“硬件简易检测”的这个想法，新手最近问的有点儿多，非常感谢版主耐心的帮助！

再问下关于VBS输出到 hta 或 html 里面“对齐”、“换行”的概念问题：

问题一：就是10楼这里，我添加内容之后，在代码里看是整齐的，通过之前 msgbox 方式输出也是整齐的，但 hta 的方式输出后无法对齐，自动“缩进”了

osinfo = "系统："& caption _
    & vbCrLf &"版本：" & version _
    & vbCrLf &"安装时间："& FormatDT(installdate) _
    & vbCrLf &"最后启动："& FormatDT(lastbootuptime)      
    & vbCrLf &"版      本： "& version  _         '就这一行，有空格之后，增加中间的空格也没有用，输出的结果就只能是   “版 本： 10.0” ，好像结果只能保留一个空格，再加也没用！
    & vbCrLf &"版                本： "& version  _   '尝试这样不行， 输出结果还是    “版 本： 10.0”
    & vbCrLf &"版         "&"              本： "& version  _   '尝试这样不行， 输出结果还是    “版 本： 10.0”
    & vbCrLf &"产品  ID： "& productid _
    & vbCrLf &"产品密钥： "& productkey _


问题二：这是一个输出为 html 的代码，我加入原先在 msgbox 或 hta 方式显示正常的一段儿代码（识别硬盘及详细分区），在这里总调整不好，不能显示正常的效果

正常效果应该是：（一块儿、一块儿检测并分别显示）

硬盘 0 型号: xxxx  标称容量: xx GB 实际容量: xx GB
分区: C 总大小: xx GB 可用空间: xx GB 使用率: xx%
分区: D 总大小: xx GB 可用空间: xx GB 使用率: xx%

硬盘 1 型号: xxxx  标称容量: xx GB 实际容量: xx GB
分区: E 总大小: xx GB 可用空间: xx GB 使用率: xx%
分区: F 总大小: xx GB 可用空间: xx GB 使用率: xx%
……

但该代码加入到输出为 html 形式的代码里之后，两块以上的硬盘，显示效果就成了下面的：（不知道怎么调整了……）
刚发现在 hta 的多硬盘情况下输出也有问题，单块儿显示没问题，还是代码我没调整好，显示是硬盘和分区分别叠加显示，而不是上面希望的正常效果，帮忙调整下，多谢！（就是循环不知道怎么调整）

硬盘 0 型号: xxxx  标称容量: xx GB 实际容量: xx GB 硬盘 1 型号: xxxx  标称容量: xx GB 实际容量: xx GB （连在一起）
分区: C 总大小: xx GB 可用空间: xx GB 使用率: xx% 分区: D 总大小: xx GB 可用空间: xx GB 使用率: xx% 分区: E 总大小: xx GB 可用空间: xx GB 使用率: xx% 分区: F 总大小: xx GB 可用空间: xx GB 使用率: xx% （出好几行，多块儿硬盘时是叠加显示的……）

html输出套用的代码：

doswork

回复 16# pcl_test


    确实，漏了一大段儿代码……
    对代码还不熟悉，多谢提醒！

pcl_test

回复 15# doswork

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

doswork

回复 10# pcl_test


    好的，是10楼您最后给调整的hta版本，我加入后报错，之前msgbox版本里面没有报错

pcl_test

回复 13# doswork

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

测试没有问题

doswork

回复 12# pcl_test

    多谢版主帮助，不过原来能用的一小段儿代码在这个新的版本里不能用了，提示：类型不匹配 ' ConvertToKey '

代码：

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

WinProductName = WshShell.RegRead(regKey & "ProductName")
productid = WshShell.RegRead(regKey & "ProductID")
productkey = ConvertToKey(DigitalProductId)
复制代码

pcl_test

回复 11# doswork


10L已整合

doswork

多谢版主！

这个好多了，大小可以自定义，我再拼接原来的

另：能帮忙处理个识别内存的代码吗？多谢！内存处理完这个VBS就算完工了~
希望效果：内存共计： xx mb    内存1：XX mb   内存2：xx mb ……

我找的一个识别内存的，但调用不出来（代码单独可用，调用就无效）……
代码如下：

Function MemoryWrite()  
                '函数，写入内存信息  
mtotal        = 0  
num         = 0  
mill         = 0  
        Set colMemory = objswbemservices.execquery("select * from win32_physicalmemory",,48)  
        For Each objitem In colMemory  
                mill = objitem.capacity/1048576  
'                WriteTable "单根内存容量",mill & "M"  
                mtotal = mtotal+mill  
                num = num + 1  
        Next  
'        WriteTable "总计内存",num & "条" & "一共" & mtotal & "M"  
End Function 
复制代码