无忧启动论坛

 找回密码
 注册
搜索
系统gho:最纯净好用系统下载站投放广告、加入VIP会员,请联系 微信:wuyouceo
查看: 2931|回复: 1
打印 上一主题 下一主题

[求助] 请高手帮忙将两个识别系统信息的VBS合并下,多谢!

[复制链接]
跳转到指定楼层
1#
发表于 2016-6-15 11:20:39 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
没有编程基础,搞不定,请高手帮忙将如下的两个vbs合并到一起,实现更多功能的显示(在一起显示,并且可以保存为.txt)

01.vbs 使用功能:补丁包、版本号、编译代号、序列号、产品ID、(该代码能实现统一显示、自动保存为.txt的功能)
系统版本(这个显示不够完整,希望用02.vbs里的替换)
比如:01.vbs只显示“Microsoft Windows XP”,但02.vbs显示的是“Microsoft Windows XP Professional”

02.vbs  使用功能:IP地址、系统版本(这个显示更详细)、IE版本

01.vbs内容:

Option Explicit


ON ERROR RESUME NEXT
Dim g_strComputer, g_objRegistry, g_EchoString


g_strComputer = "."
g_EchoString = ""


private const L_MsgErrorPKey                          = "没有安装Windows序列号, 以下为注册表残留信息。"
private const L_MsgErrorRegPKey                       = "没有在注册表中找到Windows序列号."
private const L_MsgErrorRegPID                        = "没有在注册表中找到Windows产品ID."


Private const L_MsgProductName                        = "系统:"
private const L_MsgProductDesc                        = "系统描述: "
private const L_MsgVersion                            = "版本号: "
Private Const L_MsgServicePack                        = "补丁包:"
Private Const L_MsgBuild                              = "编译代号:"


private const L_MsgProductKey                         = "序列号: "
private const L_MsgProductId                          = "产品ID: "




private const HKEY_LOCAL_MACHINE                      = &H80000002
Private Const WindowsNTInfoPath                       = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"




'If this is the local computer, set everything immediately
If g_strComputer = "." Then
Set g_objRegistry = GetObject("winmgmts:\\" & g_strComputer & "\root\default:StdRegProv")
End If


Call ExecCommand()
Call ShowInfo()


ExitScript 0




Private Sub ExecCommand


Dim productKeyFound
Dim strProductKey, strProductId, strProductVersion, strTmp
Dim bRegPKeyFound, bRegPIDFound        ' value exists in registry




'Retrieve information from registry
bRegPKeyFound = False : bRegPIDFound = False : productKeyFound = False
g_objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "DigitalProductId", strTmp
If Not IsNull(strTmp) Then
strProductKey=GetKey(strTmp)
bRegPKeyFound = True
End If
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "ProductId", strTmp
If Not IsNull(strTmp) Then
strProductId = strTmp
bRegPIDFound = True
End If


LineOut ""
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "ProductName", strTmp
LineOut GetResource("L_MsgProductName") & strTmp
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "CSDVersion", strTmp
If Not IsNull(strTmp) Then
LineOut GetResource("L_MsgServicePack") & strTmp
End If
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "CurrentVersion", strProductVersion
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "CurrentBuildNumber", strTmp
strProductVersion=strProductVersion & "." & strTmp
LineOut GetResource("L_MsgVersion") & strProductVersion
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "BuildLabEx", strTmp
If IsNull(strTmp) Then
g_objRegistry.GetStringValue HKEY_LOCAL_MACHINE, WindowsNTInfoPath, "BuildLab", strTmp
End If
LineOut GetResource("L_MsgBuild") & strTmp


productKeyFound = True


LineOut ""
If productKeyFound <> True Then
    LineOut GetResource("L_MsgErrorPKey")
End If
If bRegPKeyFound Then
    LineOut GetResource("L_MsgProductKey") & strProductKey
Else
    LineOut GetResource("L_MsgErrorRegPKey")
End If
If bRegPIDFound Then
    LineOut GetResource("L_MsgProductId") & strProductId
Else
    LineOut GetResource("L_MsgErrorRegPID")
End If


LineOut ""
LineOut "本程序用来获取查看Windows的序列号。"
LineOut "适用于绝大多数Windows系统,包括 XP/Vista/Win7 系列等。"




End Sub




Private Sub ShowInfo


Dim Ans, objFSO, outFile, strSave


Set objFSO = CreateObject("Scripting.FileSystemObject")
strSave = vbNewLine & "-----------------------------------------------------------" & vbNewLine & g_EchoString
strSave = strSave & vbNewLine & vbNewLine& "------ " & Now() & "    " & "Windows 序列号查看器保存" & " ------" & vbNewLine


LineOut ""
LineOut ""
LineOut "是否保存以上信息到文本文件 WindowsKey.txt ?"


Ans = MsgBox(g_EchoString, 4, "Windows 序列号查看器")


g_EchoString = ""
If Ans = vbYes Then
    Set outFile = objFSO.OpenTextFile(".\WindowsKey.txt", 8 , True) ' append to file
outFile.WriteLine strSave
outFile.Close
LineOut "已经保存到文件 WindowsKey.txt !"
End If


End Sub






Private Function GetKey(rpk)   'Decode the product key


Const rpkOffset=52
Dim dwAccumulator, szPossibleChars, szProductKey
dim i,j


i=28 : szPossibleChars="BCDFGHJKMPQRTVWXY2346789"
Do 'Rep1
    dwAccumulator=0 : j=14
    Do
        dwAccumulator=dwAccumulator*256
        dwAccumulator=rpk(j+rpkOffset)+dwAccumulator
        rpk(j+rpkOffset)=(dwAccumulator\24) and 255
        dwAccumulator=dwAccumulator Mod 24
        j=j-1
    Loop While j>=0
    i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey
    if (((29-i) Mod 6)=0) and (i<>-1) then
        i=i-1 : szProductKey="-"&szProductKey
    end if
Loop While i>=0 'Goto Rep1
GetKey=szProductKey
End Function




' Get the resource string with the given name using the built-in default.
Private Function GetResource(name)
GetResource = Eval(name)
End Function




Private Sub ExitScript(retval)
if (g_EchoString <> "") Then
    MsgBox g_EchoString, 0, "Windows 序列号查看器"
End If
WScript.Quit retval
End Sub


' Functions Without Change Below


Private Sub LineOut(str)
g_EchoString = g_EchoString & str & vbNewLine
End Sub


02.vbs内容:



Function GetLocalIP(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 = objAddress
Exit For
End If  
Next
Exit For
Next
a=msgbox(GetIPMAC)
End Function
GetLocalIP(".")

Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
for each objOperatingSystem in colOperatingSystems
msgbox "SO version: "& objOperatingSystem.Caption
next
Set objwmiserviceIE=GetObject("winmgmts:\\" & strComputer & "\root\cimv2\Applications\MicrosoftIE")
Set colIESettings=objwmiserviceIE.execquery("select * from MicrosoftIE_Summary")
For Each strIESetting In colIESettings
MsgBox "IE version: "&strIESetting.version
MsgBox "产品 ID:  "&strIESetting.productID
next




2个vbs.rar

2.5 KB, 下载次数: 7, 下载积分: 无忧币 -2

2#
发表于 2016-6-17 11:00:10 | 只看该作者
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|捐助支持|无忧启动 ( 闽ICP备05002490号-1 )

闽公网安备 35020302032614号

GMT+8, 2024-11-23 21:40

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表