[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

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

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

1、由于不同代码不同功能,输出是好几个界面,现希望将这几个功能的输出内容界面合并输出到一个界面来显示
2、将最终合并输出的内容以文本方式写入当前目录下的output.txt,带(是/否 输出)选项
  1. k=1
  2. Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
  3. Set wmiObjects = wmiService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
  4. '第一部分:希望在一个界面输出显示的内容
  5. For Each wmiObject In wmiObjects
  6.     msgbox "系统"&k&vblf&"" _
  7. &vblf&"计算机名: 不知道在这里显示的代码" _
  8. &vblf&"WinProductID: 不知道在这里显示的代码" _
  9. &vblf&"" _
  10. &vblf&"系统版本: "&wmiObject.Caption _
  11. &vblf&"安装时间: "&wmiObject.InstallDate  _
  12. &vblf&"最后启动: "&wmiObject.lastbootuptime  _
  13. &vblf&"能不能让时间格式显示为:2016-05-05 21:08:55 ?" _
  14. &vblf&"" _
  15. &vblf&"ip地址: 不知道在这里显示的代码" _
  16. &vblf&"MAC地址: 不知道在这里显示的代码"
  17. next
  18. '第二部分:显示“计算机名”(如果 第一部分 可以实现显示的话,这里就不用了)
  19. Set colSettings = wmiService.ExecQuery _
  20.     ("Select * from Win32_ComputerSystem")
  21. For Each objComputer in colSettings
  22.     Wscript.Echo "System Name: " & objComputer.Name
  23. next
  24. '第三部分:显示“IP、MAC地址”(如果 第一部分 可以实现显示的话,这里就不用了)
  25. Function GetIPMAC(ComputerName)
  26. Dim objWMIService,colItems,objItem,objAddress
  27. Set objWMIService = GetObject("winmgmts://" & ComputerName & "/root/cimv2")
  28. Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
  29. For Each objItem in colItems
  30. For Each objAddress in objItem.IPAddress
  31.   If objAddress <> "" then
  32.   GetIPMAC = "IP 地址:  " & objAddress  & vbNewLine &  "MAC地址:  " & objItem.MACAddress
  33.   Exit For
  34. End If  
  35. Next
  36. Exit For
  37. Next
  38. End Function
  39. WScript.Echo GetIPMAC(".")
  40. '第四部分:win10 序列号查看器(如果 第一部分 可以实现显示的话,这里就不用了)
  41. Set WshShell = CreateObject("WScript.Shell")
  42. regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
  43. DigitalProductId = WshShell.RegRead(regKey & "DigitalProductId")
  44. WinProductName = "Windows Product Name: " & WshShell.RegRead(regKey & "ProductName") & vbNewLine
  45. WinProductID = "Windows Product ID: " & WshShell.RegRead(regKey & "ProductID") & vbNewLine
  46. WinProductKey = ConvertToKey(DigitalProductId)
  47. strProductKey ="Windows Key: " & WinProductKey
  48. WinProductID = WinProductName & WinProductID & strProductKey
  49. MsgBox(WinProductID)
  50. Function ConvertToKey(regKey)
  51.     Const KeyOffset = 52
  52.     isWin8 = (regKey(66) \ 6) And 1
  53.     regKey(66) = (regKey(66) And &HF7) Or ((isWin8 And 2) * 4)
  54.     j = 24
  55.     Chars = "BCDFGHJKMPQRTVWXY2346789"
  56.     Do
  57.         Cur = 0
  58.         y = 14
  59.         Do
  60.             Cur = Cur * 256
  61.             Cur = regKey(y + KeyOffset) + Cur
  62.             regKey(y + KeyOffset) = (Cur \ 24)
  63.             Cur = Cur Mod 24
  64.             y = y -1
  65.         Loop While y >= 0
  66.         j = j -1
  67.         winKeyOutput = Mid(Chars, Cur + 1, 1) & winKeyOutput
  68.         Last = Cur
  69.     Loop While j >= 0
  70.     If (isWin8 = 1) Then
  71.         keypart1 = Mid(winKeyOutput, 2, Last)
  72.         insert = "N"
  73.         winKeyOutput = Replace(winKeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
  74.         If Last = 0 Then winKeyOutput = insert & winKeyOutput
  75.     End If
  76.     a = Mid(winKeyOutput, 1, 5)
  77.     b = Mid(winKeyOutput, 6, 5)
  78.     c = Mid(winKeyOutput, 11, 5)
  79.     d = Mid(winKeyOutput, 16, 5)
  80.     e = Mid(winKeyOutput, 21, 5)
  81.     ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
  82. End Function
复制代码
1

评分人数

    • Batcher: 感谢给帖子标题标注[已解决]字样PB + 2

本帖最后由 pcl_test 于 2016-7-3 13:37 编辑
  1. Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
  2. Set fso = CreateObject("Scripting.FileSystemObject")
  3. '第一部分:显示“系统相关信息”
  4. Set wmiObjects = wmiService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
  5. For Each wmiObject In wmiObjects
  6.     caption=wmiObject.Caption
  7.     version=wmiObject.Version
  8.     osarchitecture=wmiObject.OSArchitecture
  9.     installdate=wmiObject.InstallDate
  10.     lastbootuptime=wmiObject.LastBootUpTime
  11. Next
  12. '第二部分:显示“计算机名”
  13. Set colSettings = wmiService.ExecQuery("Select * from Win32_ComputerSystem")
  14. For Each objComputer in colSettings
  15.     computername=objComputer.Name
  16. Next
  17. '第三部分:显示“IP、MAC地址”
  18. Set colItems = wmiService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
  19. For Each objItem in colItems
  20.     For Each objAddress in objItem.IPAddress
  21.       If objAddress <> "" then
  22.           ipaddress=objAddress
  23.           macaddress=objItem.MACAddress
  24.       Exit For
  25.       End If
  26.     Next
  27.     Exit For
  28. Next
  29. '第四部分:查看系统ID、密钥
  30. Set WshShell = CreateObject("WScript.Shell")
  31. regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
  32. DigitalProductId = WshShell.RegRead(regKey & "DigitalProductId")
  33. productid = WshShell.RegRead(regKey & "ProductID")
  34. productkey = ConvertToKey(DigitalProductId)
  35. '输出
  36. file ="系统信息.txt"
  37. info = "系统:"& caption &" "& osarchitecture _
  38.     & vbCrLf &"版本:" & version _
  39.     & vbCrLf &"计算机名:" & computername _
  40.     & vbCrLf &"安装时间:"& FormatDT(installdate) _
  41.     & vbCrLf &"最后启动:"& FormatDT(lastbootuptime) _
  42.     & vbCrLf &"IP地址:"& ipaddress _
  43.     & vbCrLf &"MAC地址:"& macaddress _
  44.     & vbCrLf &"产品ID:"& productid _
  45.     & vbCrLf &"产品密钥:"& productkey
  46. IF msgbox(info &vbCrLf&vbCrLf&"是否保存以上信息到文本文件 "& file &"?", vbYesNo, "系统信息")=6 Then
  47.     fso.OpenTextFile(file, 2, true).Write info
  48. End If
  49. WSH.quit
  50. Function ConvertToKey(regKey)
  51.     Const KeyOffset = 52
  52.     isWin8 = (regKey(66) \ 6) And 1
  53.     regKey(66) = (regKey(66) And &HF7) Or ((isWin8 And 2) * 4)
  54.     j = 24
  55.     Chars = "BCDFGHJKMPQRTVWXY2346789"
  56.     Do
  57.         Cur = 0
  58.         y = 14
  59.         Do
  60.             Cur = Cur * 256
  61.             Cur = regKey(y + KeyOffset) + Cur
  62.             regKey(y + KeyOffset) = (Cur \ 24)
  63.             Cur = Cur Mod 24
  64.             y = y -1
  65.         Loop While y >= 0
  66.         j = j -1
  67.         winKeyOutput = Mid(Chars, Cur + 1, 1) & winKeyOutput
  68.         Last = Cur
  69.     Loop While j >= 0
  70.     If (isWin8 = 1) Then
  71.         keypart1 = Mid(winKeyOutput, 2, Last)
  72.         insert = "N"
  73.         winKeyOutput = Replace(winKeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
  74.         If Last = 0 Then winKeyOutput = insert & winKeyOutput
  75.     End If
  76.     a = Mid(winKeyOutput, 1, 5)
  77.     b = Mid(winKeyOutput, 6, 5)
  78.     c = Mid(winKeyOutput, 11, 5)
  79.     d = Mid(winKeyOutput, 16, 5)
  80.     e = Mid(winKeyOutput, 21, 5)
  81.     ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
  82. End Function
  83. '格式化日期时间
  84. Function FormatDT(dt)
  85.     FormatDT=left(dt, 4)&"-"&mid(dt, 5, 2)&"-"&mid(dt, 7, 2) _
  86.         &" "&mid(dt, 9, 2)&":"&mid(dt, 11, 2)&":"&mid(dt, 13, 2)
  87. End Function
复制代码

TOP

本帖最后由 doswork 于 2016-7-3 16:16 编辑

回复 2# pcl_test


    非常感谢版主帮忙修改!学习了~
   
    希望效果那个代码是用注册表的方式,有些项结果不太准确,代码很长看不懂,您的还可以学习进行相关的修改,感谢!

   第9行“   osarchitecture=wmiObject.OSArchitecture” 报错,提示:“对象不支持此属性或方法”,注释后其它正常,这句是什么意思?(xp系统)

TOP

本帖最后由 pcl_test 于 2016-7-3 16:29 编辑

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

评分人数

    • doswork: 多谢版主的帮助!技术 + 1

TOP

回复 4# pcl_test


    明白了,多谢版主!

    加分机制好像一天有限制,现在还无法加分,晚些时候再加分~

TOP

本帖最后由 doswork 于 2016-7-3 17:55 编辑

回复 4# pcl_test


    还有一个问题请教版主:怎么在输出的界面增加“空行”?我尝试原来代码不行,您的代码修改还是不行(总报错)……

'输出
file ="系统信息.txt"
info = " 系统简易信息:"  _
&vblf&"" _
        & vbCrLf &"" _
    "系统:"& caption &" "& osarchitecture _
    & vbCrLf &"版本:" & version _

TOP

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

TOP

回复 7# pcl_test


    明白了,多谢版主!

TOP

请教版主,这个输出的界面一页显示不完整(又加入网卡等信息),是不是可以通过参数设置让可显示的字数(内容)更多些?

没有显示全的内容在输出的文本中是存在的,也就是说一页没有显示全,但输出文本有。

TOP

本帖最后由 pcl_test 于 2016-7-16 02:45 编辑

回复 9# doswork
  1. Set fso = CreateObject("Scripting.FileSystemObject")
  2. Set shell = CreateObject("WScript.Shell")
  3. '获取系统相关信息
  4. Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
  5. Set Items = wmiService.ExecQuery("SELECT * FROM Win32_OperatingSystem")
  6. For Each Item In Items
  7.     caption=Item.Caption
  8.     version=Item.Version
  9.     installdate=Item.InstallDate
  10.     lastbootuptime=Item.LastBootUpTime
  11. Next
  12. osinfo = "系统:"& caption _
  13.     & vbCrLf &"版本:" & version _
  14.     & vbCrLf &"安装时间:"& FormatDT(installdate) _
  15.     & vbCrLf &"最后启动:"& FormatDT(lastbootuptime)
  16. '输出
  17. outfile ="保存信息.txt"
  18. allinfo = "msgbox并没有参数可设置对话框的大小或控制显示信息内容的多少。" _
  19.     &vbCrLf& "可以调用hta实现自定义对话框,实际可把vbs代码写到hta里," _
  20.     &vbCrLf& "完全可做出一个带美观界面的桌面应用程序,结合css或js可玩性更高" _
  21.     &vbCrLf&vbCrLf& osinfo & vbCrLf & vbCrLf & GetMemory()
  22.    
  23. ShowInfo(replace(allinfo,VbCrLf,"<br/>"))
  24. '自定义对话框
  25. Function ShowInfo(info)
  26.     Set htafile = fso.OpenTextFile("$temp.hta",2,true)
  27.     htafile.Write "<title>提示</title><script>" & _
  28.         "window.resizeTo(600,600);" & _
  29.         "function writetxt(){" & _
  30.         "var txt=document.getElementById('info').innerText.replace(/<br\/>/g, '\r\n');" & _
  31.         "(new ActiveXObject('Scripting.FileSystemObject')).OpenTextFile('"& outfile &"',2,true).write(txt);close();}" & _
  32.         "</script><div>是否保存以下信息到文本文件&nbsp;<font color='#FF0000'>"& outfile &"</font>?" & _
  33.         "<input type='button' value='是(Y)' onclick='writetxt()'>&nbsp;&nbsp;&nbsp;&nbsp;" & _
  34.         "<input type='button' value='否(N)' onclick='window.close()'></div><br/><div id='info'><font style='font-weight:bold' color='#008200'>"& info &"</font></div>"
  35.     htafile.Close
  36.     shell.Run "$temp.hta", 1, True
  37.     fso.DeleteFile "$temp.hta"
  38. End Function
  39. '格式化日期时间
  40. Function FormatDT(dt)
  41.     FormatDT=left(dt, 4)&"-"&mid(dt, 5, 2)&"-"&mid(dt, 7, 2) _
  42.         &" "&mid(dt, 9, 2)&":"&mid(dt, 11, 2)&":"&mid(dt, 13, 2)
  43. End Function
  44. '内存信息
  45. Function GetMemory()
  46.     mtotal=0
  47.     num=0
  48.     s=""
  49.     Set colMemory = wmiService.execquery("select * from win32_physicalmemory",,48)
  50.     For Each objitem In colMemory
  51.         mtotal = mtotal+objitem.capacity
  52.         num = num + 1
  53.         s=s&"内存"& num &":"&(objitem.capacity/1048576)&"M "
  54.     Next  
  55.     GetMemory="总计内存"& num & "条,共" & (mtotal/1048576) & "M " &s
  56. End Function
复制代码

TOP

多谢版主!

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

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

我找的一个识别内存的,但调用不出来(代码单独可用,调用就无效)……
代码如下:
  1. Function MemoryWrite()  
  2.                 '函数,写入内存信息  
  3. mtotal        = 0  
  4. num         = 0  
  5. mill         = 0  
  6.         Set colMemory = objswbemservices.execquery("select * from win32_physicalmemory",,48)  
  7.         For Each objitem In colMemory  
  8.                 mill = objitem.capacity/1048576  
  9. '                WriteTable "单根内存容量",mill & "M"  
  10.                 mtotal = mtotal+mill  
  11.                 num = num + 1  
  12.         Next  
  13. '        WriteTable "总计内存",num & "条" & "一共" & mtotal & "M"  
  14. End Function
复制代码

TOP

回复 11# doswork


10L已整合

TOP

本帖最后由 pcl_test 于 2016-7-7 11:49 编辑

回复 12# pcl_test

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

代码:
  1. '第四部分:查看系统ID、密钥
  2. Set WshShell = CreateObject("WScript.Shell")
  3. regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
  4. DigitalProductId = WshShell.RegRead(regKey & "DigitalProductId")
  5. WinProductName = WshShell.RegRead(regKey & "ProductName")
  6. productid = WshShell.RegRead(regKey & "ProductID")
  7. productkey = ConvertToKey(DigitalProductId)
复制代码

TOP

回复 13# doswork

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

测试没有问题

TOP

本帖最后由 pcl_test 于 2016-7-7 13:11 编辑

回复 10# pcl_test


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

TOP

返回列表