WMI更换WINDOWS序列号(IE7安装时的"序列号破解"方式中学到的东西)

引用WMI,添加一个TEXTBOX,一个COMMAND,以下是代码,成品在下载区

Option Explicit

Dim objSWbemLocator As SWbemLocator
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
Dim strComputer As String, strNameSpace As String, strClass As String

Private Sub Form_Load()
    Text1.Font.Size = 20
    Text1.Text = "MRX3F-47B9T-2487J-KWKMF-RPWBY"
    strComputer = "."           '计算机名，.为本机
    strNameSpace = "root/cimv2" '指定命名空间为root/cimv2
    strClass = "win32_WindowsProductActivation"  '指定类为Win32_Service
    Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")    '建立1个对象的引用指针
    Set objSWbemServices = objSWbemLocator.ConnectServer(strComputer, strNameSpace)  '连接到指定计算机、命名空间的WMI，返回一个对  对象的引用
End Sub

'刷新
Sub RefreshList()
Print "请参考MS:http://www.microsoft.com/china/windowsxp/pro/techinfo/deployment/activation/scripted.asp"
Dim mStr As String
    Set objSWbemObjectSet = objSWbemServices.ExecQuery("SELECT * FROM " & strClass)  '通过WQL查询，返回指定类的所有
    For Each objSWbemObject In objSWbemObjectSet
        Print mFormat("计算机名称   ", objSWbemObject.ServerName)  '计算机名
        Print mFormat("需要激活   ", mYesNo(objSWbemObject.ActivationRequired))   '需要激活，该值应值设为 1（表有效）。否则，设为0（表无效）。
        mStr = objSWbemObject.ProductID
        Print mFormat("安装序列号信息   ", mStr) '包含根据系统安装序列号得来的一个连续的9位数字,表示为“sssssssss”。除OEM外的所有系统，其格式均为：“xxxxx-sss-ssssssx-xxxxx”。而OEM的格式为：“xxxxx-OEM-xxssssx-sssss”。
        Print mFormat("为OEM版本", mYesNo(mStr))
        Print mFormat("剩余的评测期   ", objSWbemObject.RemainingEvaluationPeriod) '剩余的评测期,仅适用于测试版和评测版，表示剩余的天数。其最大的整数值可以是：2147483647。
        Print mFormat("剩余的有效期   ", objSWbemObject.RemainingGracePeriod)     '剩余的有效期
        'objSWbemObject.GetInstallationID (mStr) '该方法返回PID
        'Debug.Print mStr
    Next
End Sub

Private Sub Form_Paint()
RefreshList         '显示当前信息
End Sub

Private Function mYesNo(lng As String) As String
    If InStr(1, lng, "-") Then
        If InStr(1, lng, "OEM") Then mYesNo = "是" Else mYesNo = "否"
    Else
        If lng = 0 Then mYesNo = "否" Else mYesNo = "是"
    End If
End Function

Private Function mFormat(str1 As String, str2 As String) As String
    mFormat = Left(str1 & Space(20 - LenB(str1)), 20) & str2
End Function

Private Sub Command1_Click()
Dim mStr As String, mStrNew As String
    Set objSWbemObjectSet = objSWbemServices.ExecQuery("SELECT * FROM " & strClass)  '通过WQL查询，返回指定类的所有
    For Each objSWbemObject In objSWbemObjectSet
        objSWbemObject.GetInstallationID (mStr) '该方法返回PID
        objSWbemObject.SetProductKey Replace(Text1.Text, "-", "")
        objSWbemObject.GetInstallationID (mStrNew)
        If mStr = mStrNew Then Me.Caption = "序列号未替换" Else Me.Caption = "序列号已经替换"
    Next
End Sub