Board logo

标题: [问题求助] [已解决]VBS如何实现同一对话框显示几段代码的执行结果并可选择是否输出结果到文本 [打印本页]
作者: doswork    时间: 2016-7-2 21:55     标题: [已解决]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. '第一部分：希望在一个界面输出显示的内容

  6. For Each wmiObject In wmiObjects

  7.     msgbox "系统"&k&vblf&"" _

  8.  &vblf&"计算机名： 不知道在这里显示的代码" _

  9.  &vblf&"WinProductID： 不知道在这里显示的代码" _

  10.  &vblf&"" _

  11.  &vblf&"系统版本： "&wmiObject.Caption _

  12.  &vblf&"安装时间： "&wmiObject.InstallDate  _ 

  13.  &vblf&"最后启动： "&wmiObject.lastbootuptime  _

  14.  &vblf&"能不能让时间格式显示为：2016-05-05 21:08:55 ？" _

  15.  &vblf&"" _

  16.  &vblf&"ip地址： 不知道在这里显示的代码" _

  17.  &vblf&"MAC地址： 不知道在这里显示的代码" 

  18. next 

  19. 

  20. '第二部分：显示“计算机名”（如果 第一部分 可以实现显示的话，这里就不用了）

  21. Set colSettings = wmiService.ExecQuery _

  22.     ("Select * from Win32_ComputerSystem")

  23. For Each objComputer in colSettings 

  24.     Wscript.Echo "System Name: " & objComputer.Name

  25. 

  26. next 

  27. 

  28. '第三部分：显示“IP、MAC地址”（如果 第一部分 可以实现显示的话，这里就不用了）

  29. Function GetIPMAC(ComputerName) 

  30. Dim objWMIService,colItems,objItem,objAddress

  31. Set objWMIService = GetObject("winmgmts://" & ComputerName & "/root/cimv2")

  32. Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

  33. For Each objItem in colItems

  34.  For Each objAddress in objItem.IPAddress

  35.   If objAddress <> "" then

  36.   GetIPMAC = "IP 地址：  " & objAddress  & vbNewLine &  "MAC地址：  " & objItem.MACAddress

  37.   Exit For

  38.  End If  

  39.  Next

  40.  Exit For

  41. Next

  42. End Function

  43. 

  44. WScript.Echo GetIPMAC(".")

  45. 

  46. '第四部分：win10 序列号查看器（如果 第一部分 可以实现显示的话，这里就不用了）

  47. Set WshShell = CreateObject("WScript.Shell")

  48. regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"

  49. DigitalProductId = WshShell.RegRead(regKey & "DigitalProductId")

  50. 

  51. WinProductName = "Windows Product Name: " & WshShell.RegRead(regKey & "ProductName") & vbNewLine

  52. WinProductID = "Windows Product ID: " & WshShell.RegRead(regKey & "ProductID") & vbNewLine

  53. WinProductKey = ConvertToKey(DigitalProductId)

  54. strProductKey ="Windows Key: " & WinProductKey 

  55. WinProductID = WinProductName & WinProductID & strProductKey

  56. 

  57. 

  58. MsgBox(WinProductID)

  59. 

  60. 

  61. Function ConvertToKey(regKey)

  62.     Const KeyOffset = 52

  63.     isWin8 = (regKey(66) \ 6) And 1

  64.     regKey(66) = (regKey(66) And &HF7) Or ((isWin8 And 2) * 4)

  65.     j = 24

  66.     Chars = "BCDFGHJKMPQRTVWXY2346789"

  67.     Do

  68.         Cur = 0

  69.         y = 14

  70.         Do

  71.             Cur = Cur * 256

  72.             Cur = regKey(y + KeyOffset) + Cur

  73.             regKey(y + KeyOffset) = (Cur \ 24)

  74.             Cur = Cur Mod 24

  75.             y = y -1

  76.         Loop While y >= 0

  77.         j = j -1

  78.         winKeyOutput = Mid(Chars, Cur + 1, 1) & winKeyOutput

  79.         Last = Cur

  80.     Loop While j >= 0

  81.     If (isWin8 = 1) Then

  82.         keypart1 = Mid(winKeyOutput, 2, Last)

  83.         insert = "N"

  84.         winKeyOutput = Replace(winKeyOutput, keypart1, keypart1 & insert, 2, 1, 0)

  85.         If Last = 0 Then winKeyOutput = insert & winKeyOutput

  86.     End If

  87.     a = Mid(winKeyOutput, 1, 5)

  88.     b = Mid(winKeyOutput, 6, 5)

  89.     c = Mid(winKeyOutput, 11, 5)

  90.     d = Mid(winKeyOutput, 16, 5)

  91.     e = Mid(winKeyOutput, 21, 5)

  92.     ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e

  93. End Function
复制代码
作者: pcl_test    时间: 2016-7-3 12:37

本帖最后由 pcl_test 于 2016-7-3 13:37 编辑 
  1. Set wmiService = GetObject("winmgmts:\\.\root\cimv2")

  2. Set fso = CreateObject("Scripting.FileSystemObject")

  3. 

  4. '第一部分：显示“系统相关信息”

  5. Set wmiObjects = wmiService.ExecQuery("SELECT * FROM Win32_OperatingSystem")

  6. For Each wmiObject In wmiObjects

  7.     caption=wmiObject.Caption

  8.     version=wmiObject.Version

  9.     osarchitecture=wmiObject.OSArchitecture

  10.     installdate=wmiObject.InstallDate

  11.     lastbootuptime=wmiObject.LastBootUpTime

  12. Next

  13. 

  14. '第二部分：显示“计算机名”

  15. Set colSettings = wmiService.ExecQuery("Select * from Win32_ComputerSystem")

  16. For Each objComputer in colSettings

  17.     computername=objComputer.Name

  18. Next

  19. 

  20. '第三部分：显示“IP、MAC地址”

  21. Set colItems = wmiService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

  22. For Each objItem in colItems

  23.     For Each objAddress in objItem.IPAddress

  24.       If objAddress <> "" then

  25.           ipaddress=objAddress 

  26.           macaddress=objItem.MACAddress

  27.       Exit For

  28.       End If

  29.     Next

  30.     Exit For

  31. Next

  32. 

  33. '第四部分：查看系统ID、密钥

  34. Set WshShell = CreateObject("WScript.Shell")

  35. regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"

  36. DigitalProductId = WshShell.RegRead(regKey & "DigitalProductId")

  37. 

  38. productid = WshShell.RegRead(regKey & "ProductID")

  39. productkey = ConvertToKey(DigitalProductId)

  40. 

  41. '输出

  42. file ="系统信息.txt"

  43. info = "系统："& caption &" "& osarchitecture _

  44.     & vbCrLf &"版本：" & version _

  45.     & vbCrLf &"计算机名：" & computername _

  46.     & vbCrLf &"安装时间："& FormatDT(installdate) _

  47.     & vbCrLf &"最后启动："& FormatDT(lastbootuptime) _

  48.     & vbCrLf &"IP地址："& ipaddress _

  49.     & vbCrLf &"MAC地址："& macaddress _

  50.     & vbCrLf &"产品ID："& productid _

  51.     & vbCrLf &"产品密钥："& productkey

  52. 

  53. IF msgbox(info &vbCrLf&vbCrLf&"是否保存以上信息到文本文件 "& file &"？", vbYesNo, "系统信息")=6 Then

  54.     fso.OpenTextFile(file, 2, true).Write info

  55. End If

  56. WSH.quit

  57. 

  58. Function ConvertToKey(regKey)

  59.     Const KeyOffset = 52

  60.     isWin8 = (regKey(66) \ 6) And 1

  61.     regKey(66) = (regKey(66) And &HF7) Or ((isWin8 And 2) * 4)

  62.     j = 24

  63.     Chars = "BCDFGHJKMPQRTVWXY2346789"

  64.     Do

  65.         Cur = 0

  66.         y = 14

  67.         Do

  68.             Cur = Cur * 256

  69.             Cur = regKey(y + KeyOffset) + Cur

  70.             regKey(y + KeyOffset) = (Cur \ 24)

  71.             Cur = Cur Mod 24

  72.             y = y -1

  73.         Loop While y >= 0

  74.         j = j -1

  75.         winKeyOutput = Mid(Chars, Cur + 1, 1) & winKeyOutput

  76.         Last = Cur

  77.     Loop While j >= 0

  78.     If (isWin8 = 1) Then

  79.         keypart1 = Mid(winKeyOutput, 2, Last)

  80.         insert = "N"

  81.         winKeyOutput = Replace(winKeyOutput, keypart1, keypart1 & insert, 2, 1, 0)

  82.         If Last = 0 Then winKeyOutput = insert & winKeyOutput

  83.     End If

  84.     a = Mid(winKeyOutput, 1, 5)

  85.     b = Mid(winKeyOutput, 6, 5)

  86.     c = Mid(winKeyOutput, 11, 5)

  87.     d = Mid(winKeyOutput, 16, 5)

  88.     e = Mid(winKeyOutput, 21, 5)

  89.     ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e

  90. End Function

  91. 

  92. '格式化日期时间

  93. Function FormatDT(dt)

  94.     FormatDT=left(dt, 4)&"-"&mid(dt, 5, 2)&"-"&mid(dt, 7, 2) _

  95.         &" "&mid(dt, 9, 2)&":"&mid(dt, 11, 2)&":"&mid(dt, 13, 2)

  96. End Function
复制代码
作者: doswork    时间: 2016-7-3 16:13

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

回复 2# pcl_test


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

   第9行“   osarchitecture=wmiObject.OSArchitecture” 报错，提示：“对象不支持此属性或方法”，注释后其它正常，这句是什么意思？（xp系统）
作者: pcl_test    时间: 2016-7-3 16:26

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

OSArchitecture表示系统位数32/64，不支持说明xp系统的Win32_OperatingSystem没有该属性
作者: doswork    时间: 2016-7-3 16:35

回复 4# pcl_test


    明白了，多谢版主！

    加分机制好像一天有限制，现在还无法加分，晚些时候再加分~
作者: doswork    时间: 2016-7-3 17:20

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

回复 4# pcl_test


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

'输出
file ="系统信息.txt"
info = " 系统简易信息："  _
&vblf&"" _
        & vbCrLf &"" _
    "系统："& caption &" "& osarchitecture _
    & vbCrLf &"版本：" & version _
作者: pcl_test    时间: 2016-7-3 20:00

  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
复制代码
作者: doswork    时间: 2016-7-3 20:08

回复 7# pcl_test


    明白了，多谢版主！
作者: doswork    时间: 2016-7-5 16:22

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

没有显示全的内容在输出的文本中是存在的，也就是说一页没有显示全，但输出文本有。
作者: pcl_test    时间: 2016-7-5 18:56

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

回复 9# doswork 
  1. Set fso = CreateObject("Scripting.FileSystemObject")

  2. Set shell = CreateObject("WScript.Shell")

  3. 

  4. '获取系统相关信息

  5. Set wmiService = GetObject("winmgmts:\\.\root\cimv2")

  6. Set Items = wmiService.ExecQuery("SELECT * FROM Win32_OperatingSystem")

  7. For Each Item In Items

  8.     caption=Item.Caption

  9.     version=Item.Version

  10.     installdate=Item.InstallDate

  11.     lastbootuptime=Item.LastBootUpTime

  12. Next

  13. 

  14. osinfo = "系统："& caption _

  15.     & vbCrLf &"版本：" & version _

  16.     & vbCrLf &"安装时间："& FormatDT(installdate) _

  17.     & vbCrLf &"最后启动："& FormatDT(lastbootuptime)

  18. 

  19. '输出

  20. outfile ="保存信息.txt"

  21. allinfo = "msgbox并没有参数可设置对话框的大小或控制显示信息内容的多少。" _

  22.     &vbCrLf& "可以调用hta实现自定义对话框，实际可把vbs代码写到hta里，" _

  23.     &vbCrLf& "完全可做出一个带美观界面的桌面应用程序，结合css或js可玩性更高" _

  24.     &vbCrLf&vbCrLf& osinfo & vbCrLf & vbCrLf & GetMemory()

  25.     

  26. ShowInfo(replace(allinfo,VbCrLf,"<br/>"))

  27. 

  28. '自定义对话框

  29. Function ShowInfo(info)

  30.     Set htafile = fso.OpenTextFile("$temp.hta",2,true)

  31.     htafile.Write "<title>提示</title><script>" & _

  32.         "window.resizeTo(600,600);" & _

  33.         "function writetxt(){" & _

  34.         "var txt=document.getElementById('info').innerText.replace(/<br\/>/g, '\r\n');" & _

  35.         "(new ActiveXObject('Scripting.FileSystemObject')).OpenTextFile('"& outfile &"',2,true).write(txt);close();}" & _

  36.         "</script><div>是否保存以下信息到文本文件&nbsp;<font color='#FF0000'>"& outfile &"</font>？" & _

  37.         "<input type='button' value='是(Y)' onclick='writetxt()'>&nbsp;&nbsp;&nbsp;&nbsp;" & _

  38.         "<input type='button' value='否(N)' onclick='window.close()'></div><br/><div id='info'><font style='font-weight:bold' color='#008200'>"& info &"</font></div>"

  39.     htafile.Close

  40.     shell.Run "$temp.hta", 1, True

  41.     fso.DeleteFile "$temp.hta"

  42. End Function

  43. 

  44. '格式化日期时间

  45. Function FormatDT(dt)

  46.     FormatDT=left(dt, 4)&"-"&mid(dt, 5, 2)&"-"&mid(dt, 7, 2) _

  47.         &" "&mid(dt, 9, 2)&":"&mid(dt, 11, 2)&":"&mid(dt, 13, 2)

  48. End Function

  49. 

  50. '内存信息

  51. Function GetMemory()

  52.     mtotal=0

  53.     num=0

  54.     s=""

  55.     Set colMemory = wmiService.execquery("select * from win32_physicalmemory",,48)

  56.     For Each objitem In colMemory

  57.         mtotal = mtotal+objitem.capacity

  58.         num = num + 1

  59.         s=s&"内存"& num &"："&(objitem.capacity/1048576)&"M "

  60.     Next  

  61.     GetMemory="总计内存"& num & "条，共" & (mtotal/1048576) & "M " &s 

  62. End Function 
复制代码
作者: doswork    时间: 2016-7-5 22:28

多谢版主！

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

另：能帮忙处理个识别内存的代码吗？多谢！内存处理完这个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 
复制代码
作者: pcl_test    时间: 2016-7-5 22:50

回复 11# doswork


10L已整合
作者: doswork    时间: 2016-7-7 11:42

本帖最后由 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. 

  6. WinProductName = WshShell.RegRead(regKey & "ProductName")

  7. productid = WshShell.RegRead(regKey & "ProductID")

  8. productkey = ConvertToKey(DigitalProductId)
复制代码
作者: pcl_test    时间: 2016-7-7 11:49

回复 13# doswork

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

测试没有问题
作者: doswork    时间: 2016-7-7 13:07

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

回复 10# pcl_test


    好的，是10楼您最后给调整的hta版本，我加入后报错，之前msgbox版本里面没有报错
作者: pcl_test    时间: 2016-7-7 13:13

回复 15# doswork

ConvertToKey是个自定义函数，你不能把函数体给漏了，这种低级错误不该犯
Function ConvertToKey(regKey)
……
End Function
作者: doswork    时间: 2016-7-7 13:36

回复 16# pcl_test


    确实，漏了一大段儿代码……
    对代码还不熟悉，多谢提醒！
作者: doswork    时间: 2016-7-7 19:06

回复 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输出套用的代码：
作者: pcl_test    时间: 2016-7-7 21:20

本帖最后由 pcl_test 于 2016-7-7 21:23 编辑

回复 18# doswork

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

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

  2.     a=i  '未叠加

  3.     b=b&i  '叠加

  4.     msgbox "a="&a&" b="&b

  5. next
复制代码
作者: doswork    时间: 2016-7-7 23:10

回复 19# pcl_test


    非常感谢版主指点！
    目前的问题全部解决完毕~
作者: doswork    时间: 2016-7-8 18:24

本帖最后由 doswork 于 2016-7-9 18:26 编辑

回复 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
  1.                    For Each oLD In cLD

  2.                      Dx = Dx _

  3.                         & vbTab & oLD.DeviceID &" " & Left(oLD.VolumeName&"         " ,11) & Left(oLD.FileSystem&"   " ,6) & "共:" _

  4.                         & Right("    "&Round(oLD.Size/1073741824,1),6)                &" GB    可用:" _

  5.                         & Right("    "&Round(oLD.FreeSpace/1073741824,1),6)           &" GB    使用率:"_

  6. 			& CInt( (100*((oLD.Size-oLD.FreeSpace)/oLD.Size)) ) &"%"  & vbCrLf

  7. 					WriteTable "分区信息",dx  

  8.                    Next
复制代码
作者: doswork    时间: 2016-7-9 20:31

回复 19# pcl_test


    您好版主，能再帮最后一个忙吗？
vbs转换成hta后的 不对齐 问题，上一楼 详述，十分感谢！
作者: pcl_test    时间: 2016-7-9 23:14

本帖最后由 pcl_test 于 2016-7-25 00:19 编辑

回复 21# doswork 
  1. Set fso = CreateObject("Scripting.FileSystemObject")

  2. Set shell = CreateObject("WScript.Shell")

  3. 

  4. str="c: ntfs"&vbTab&"共：55 GB"&vbTab&"可用15 GB"&vbTab&"使用率 60%" _

  5.     & vbCrLf &"d: ntfs"&vbTab&"共：95.512 GB"&vbTab&"可用15.512 GB"&vbTab&"使用率 60%" _

  6.     & vbCrLf &"e: fat32"&vbTab&"共：95 GB"&vbTab&"可用1.5 GB"&vbTab&"使用率 2%"

  7. 

  8. 

  9. outfile="outfile.txt"

  10. msgbox(str)

  11. ShowInfo(replace("方法一，表格<br/>"&formatTable(str), VbCrLf, "<br/>"))

  12. ShowInfo(replace("方法二，按字段长度填充空格<br/>"&formatSpace(str), VbCrLf, "<br/>"))

  13. 

  14. '自定义对话框

  15. Function ShowInfo(info)

  16.     CreateObject("WScript.Shell").Exec("mshta.exe ""about:<hta:application showintaskbar=no />" &_

  17.         "<title>提示</title><script>window.resizeTo(600, 600);" & _

  18.         "function writetxt(){var txt=document.getElementById('info').innerText.replace(/<br\/>/g, '\r\n');" & _

  19.         "(new ActiveXObject('Scripting.FileSystemObject')).OpenTextFile('"& outfile &"',2,true).write(txt);close();}</script>" & _

  20.         "<body style='font-family:SimSun;'><div style='position:fixed;top:0;left:0;'>是否保存以下信息到文本文件&nbsp;<font style='color:#FF0000;'>"& outfile &"</font>？" & _

  21.         "<input type='button' value='是(Y)' onclick='writetxt()'>&nbsp;&nbsp;&nbsp;&nbsp;" & _

  22.         "<input type='button' value='否(N)' onclick='window.close()'></div><br/><div id='info'><font style='color:#008200;'>"& info &"</font></div></body>""").StdOut.ReadAll

  23. End Function

  24. 

  25. '套入表格

  26. Function formatTable(str)

  27.     tr=split(str, vbCrLf)

  28.     For i=0 to Ubound(tr)

  29.         s=s&"<tr>"

  30.         td = split(tr(i), vbTab)

  31.         For j=0 to Ubound(td)

  32.             s=s&"<td>"&td(j)&"</td>"

  33.         Next

  34.         s=s&"</tr>"

  35.     Next

  36.     formatTable="<table>"&s&"</table>"

  37. End Function

  38. 

  39. '按字段长度填充空格

  40. Function formatSpace(str)

  41.     sp=Space(100)

  42.     Set objDict = WSH.CreateObject("Scripting.Dictionary")

  43.     tr=split(str, vbCrLf)

  44.     For i=0 to Ubound(tr)

  45.         td = split(tr(i), vbTab)

  46.         For j=0 to Ubound(td)

  47.             l=0

  48.             n=0

  49.             For k=1 to len(td(j))

  50.                 c=Asc(Mid(td(j), k, 1))

  51.                 If c>0 and c<127 Then

  52.                     l = l+1

  53.                 Else

  54.                     n = n+1

  55.                     l = l+2

  56.                 End If

  57.             Next

  58.             If n>0 Then objDict.Add "#"&i&j, n

  59.             If not objDict.Exists(j) Then

  60.                 objDict.Add j, l

  61.             Else

  62.                 If l > CInt(objDict.Item(j)) Then objDict.Item(j)=l

  63.             End If

  64.         Next

  65.     Next

  66.     

  67.     For i=0 to Ubound(tr)

  68.         td = split(tr(i), vbTab)

  69.         For j=0 to Ubound(td)-1

  70.             If objDict.Exists("#"&i&j) Then

  71.                 s=s&replace(left(td(j)&sp, objDict.Item(j)-objDict.Item("#"&i&j)+3), " ", "&nbsp;")

  72.             Else

  73.                 s=s&replace(left(td(j)&sp, objDict.Item(j)+3), " ", "&nbsp;")

  74.             End If

  75.         Next

  76.         s=s&td(Ubound(td))&vbCrLf

  77.     Next

  78.     formatSpace=s

  79. End Function
复制代码
作者: doswork    时间: 2016-7-10 11:41

回复 23# pcl_test


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



欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2