home *** CD-ROM | disk | FTP | other *** search
Wrap
Text File | 2008-01-05 | 78.2 KB | 1,785 lines
' ' Copyright (c) Microsoft Corporation. All rights reserved. ' ' Windows Software Licensing Management Tool. ' ' Script Name: slmgr.vbs ' Dim g_objWMIService, g_strComputer, g_strUserName, g_strPassword g_strComputer = "." Dim g_serviceConnected g_serviceConnected = False dim g_EchoString g_EchoString = "" dim g_objRegistry Dim g_resourceDictionary, g_resourcesLoaded Set g_resourceDictionary = CreateObject("Scripting.Dictionary") g_resourcesLoaded = False ' Messages 'Global options private const L_optInstallProductKey = "ipk" private const L_optInstallProductKeyUsage = "Install product key (replaces existing key)" private const L_optUninstallProductKey = "upk" private const L_optUninstallProductKeyUsage = "Uninstall product key" private const L_optActivateProduct = "ato" private const L_optActivateProductUsage = "Activate Windows" private const L_optDisplayInformation = "dli" private const L_optDisplayInformationUsage = "Display license information (default: current license)" private const L_optDisplayInformationVerbose = "dlv" private const L_optDisplayInformationUsageVerbose = "Display detailed license information (default: current license)" private const L_optExpirationDatime = "xpr" private const L_optExpirationDatimeUsage = "Expiration date for current license state" 'Advanced options private const L_optClearPKeyFromRegistry = "cpky" private const L_optClearPKeyFromRegistryUsage = "Clear product key from the registry (prevents disclosure attacks)" private const L_optInstallLicense = "ilc" private const L_optInstallLicenseUsage = "Install license" private const L_optReinstallLicenses = "rilc" private const L_optReinstallLicensesUsage = "Re-install system license files" private const L_optDisplayIID = "dti" private const L_optDisplayIIDUsage = "Display Installation ID for offline activation" private const L_optPhoneActivateProduct = "atp" private const L_optPhoneActivateProductUsage = "Activate product with user-provided Confirmation ID" private const L_optReArmWindows = "rearm" private const L_optReArmWindowsUsage = "Reset the licensing status of the machine" 'KMS options private const L_optSetKmsName = "skms" private const L_optSetKmsNameUsage = "Set the name and/or the port for the KMS computer this machine will use" private const L_optClearKmsName = "ckms" private const L_optClearKmsNameUsage = "Clear name of KMS computer used (sets the port to the default)" private const L_optSetActivationInterval = "sai" private const L_optSetActivationIntervalUsage = "Set interval (minutes) for unactivated clients to attempt KMS connection. The activation interval must be between 15 minutes (min) and 30 days (max) although the default (2 hours) is recommended." private const L_optSetRenewalInterval = "sri" private const L_optSetRenewalIntervalUsage = "Set renewal interval (minutes) for activated clients to attempt KMS connection. The renewal interval must be between 15 minutes (min) and 30 days (max) although the default (7 days) is recommended." private const L_optSetKmsListenPort = "sprt" private const L_optSetKmsListenPortUsage = "Set TCP port KMS will use to communicate with clients" private const L_optSetDNS = "sdns" private const L_optSetDNSUsage = "Enable DNS publishing by KMS (default)" private const L_optClearDNS = "cdns" private const L_optClearDNSUsage = "Disable DNS publishing by KMS" private const L_optSetNormalPriority = "spri" private const L_optSetNormalPriorityUsage = "Set KMS priority to normal (default)" private const L_optClearNormalPriority = "cpri" private const L_optClearNormalPriorityUsage = "Set KMS priority to low" ' Option parameters private const L_ParamsActivationID = "<Activation ID>" private const L_ParamsActivationIDOptional = "[Activation ID]" private const L_ParamsActIDOptional = "[Activation ID | All]" private const L_ParamsProductKey = "<Product Key>" private const L_ParamsLicenseFile = "<License file>" private const L_ParamsPhoneActivate = "<Confirmation ID>" private const L_ParamsSetKms = "<Name[:Port] | :Port>" private const L_ParamsSetListenKmsPort = "<Port>" private const L_ParamsSetActivationInterval = "<Activation Interval>" private const L_ParamsSetRenewalInterval = "<Renewal Interval>" ' Miscellaneous messages private const L_MsgHelp_1 = "Windows Software Licensing Management Tool" private const L_MsgHelp_2 = "Usage: slmgr.vbs [MachineName [User Password]] [<Option>]" private const L_MsgHelp_3 = "MachineName: Name of remote machine (default is local machine)" private const L_MsgHelp_4 = "User: Account with required privilege on remote machine" private const L_MsgHelp_5 = "Password: password for the previous account" private const L_MsgGlobalOptions = "Global Options:" private const L_MsgAdvancedOptions = "Advanced Options:" private const L_MsgKmsClientOptions = "Volume Licensing: Key Management Service (KMS) Client Options:" private const L_MsgKmsOptions = "Volume Licensing: Key Management Service (KMS) Options:" private const L_MsgMissingOption = "Option is missing and it must be provided" private const L_MsgUnrecognizedOption = "Unrecognized option: " private const L_MsgErrorProductNotFound = "Error: product not found." private const L_MsgClearedPKey = "Product key from registry cleared successfully." private const L_MsgInstalledPKey = "Installed product key %PKEY% successfully." private const L_MsgUninstalledPKey = "Uninstalled product key successfully." private const L_MsgErrorPKey = "Error: product key not found." private const L_MsgInstallationID = "Installation ID: " private const L_MsgPhoneNumbers = "Product activation telephone numbers can be obtained by searching the phone.inf file for the appropriate phone number for your location/country. You can open the phone.inf file from a Command Prompt or the Start Menu by running: notepad %systemroot%\system32\slui\phone.inf" private const L_MsgActivating = "Activating %PRODUCTNAME% (%PRODUCTID%) ..." private const L_MsgActivated = "Product activated successfully." private const L_MsgActivated_Failed = "Error: Product activation failed." private const L_MsgConfID = "Confirmation ID for product %ACTID% deposited successfully." private const L_MsgErrorDescription = "Error description: " private const L_MsgErrorConnection = "Error 0x%ERRCODE% occurred in connecting to server %COMPUTERNAME%." private const L_MsgErrorConnectionRegistry = "Error 0x%ERRCODE% occurred in connecting to the registry on server %COMPUTERNAME%." private const L_MsgErrorConnectionProcessor = "Error 0x%ERRCODE% occurred in connecting to the processor on server %COMPUTERNAME%." private const L_MsgErrorImpersonation = "Error 0x%ERRCODE% occurred in setting impersonation level." private const L_MsgErrorWMI = "Error 0x%ERRCODE% occurred in creating a locator object." private const L_MsgErrorText_1 = "Access denied: the requested action requires elevated privileges." private const L_MsgErrorText_2 = "Could not find a KMS machine." private const L_MsgErrorText_3 = "The software licensing service reported that the requested permission is not available." private const L_MsgErrorText_4 = "The computer could not be activated. The returned count from your Key Management Service is insufficient." private const L_MsgErrorText_5 = "The computer could not be activated. The Key Management Service could not be reached." private const L_MsgErrorText_6 = "Run 'slui.exe 0x2a 0x%ERRCODE%' to display the error text." private const L_MsgErrorText_8 = "Error: " private const L_MsgErrorText_9 = "Error: option %OPTION% needs %PARAM%" private const L_MsgErrorText_10 = "The maximum allowed number of re-arms has been exceeded. You must re-install the OS before trying to re-arm again." private const L_MsgErrorText_11 = "The machine is running within the non-genuine grace period. Please run 'slui.exe 0x31' to go online and make the machine genuine." private const L_MsgErrorText_12 = "Windows is running within the non-genuine notification period. Please run 'slui.exe 0x31' to go online and validate Windows." private const L_MsgLicenseFile = "License file %LICENSEFILE% installed successfully." private const L_MsgKmsPriSetToLow = "KMS priority set to Low" private const L_MsgKmsPriSetToNormal = "KMS priority set to Normal" private const L_MsgWarningKmsPri = "Warning: Priority can only be set on a KMS machine that is also activated." private const L_MsgKmsDnsPublishingDisabled = "DNS publishing disabled" private const L_MsgKmsDnsPublishingEnabled = "DNS publishing enabled" private const L_MsgKmsDnsPublishingWarning = "Warning: DNS Publishing can only be set on a KMS machine that is also activated." private const L_MsgKmsPortSet = "KMS port set to %PORT% successfully." private const L_MsgWarningKmsReboot = "Warning: a KMS reboot is needed for this setting to take effect." private const L_MsgWarningKmsPort = "Warning: KMS port can only be set on a KMS machine that is also activated." private const L_MsgRenewalSet = "Volume renewal interval set to %RENEWAL% minutes successfully." private const L_MsgWarningRenewal = "Warning: Volume renewal interval can only be set on a KMS machine that is also activated." private const L_MsgActivationSet = "Volume activation interval set to %ACTIVATION% minutes successfully." private const L_MsgWarningActivation = "Warning: Volume activation interval can only be set on a KMS machine that is also activated." private const L_MsgKmsNameSet = "Key Management Service machine name set to %KMS% successfully." private const L_MsgKmsNameCleared = "Key Management Service machine name cleared successfully." private const L_MsgRearm_1 = "Command completed successfully." private const L_MsgRearm_2 = "Please restart the system for the changes to take effect." private const L_MsgLicenseStatusUnlicensed = "Windows is unlicensed" private const L_MsgLicenseStatusVL = "Volume activation will expire %ENDDATE%" private const L_MsgLicenseStatusLicensed = "The machine is permanently activated." private const L_MsgLicenseStatusInitialGrace = "Initial grace period ends %ENDDATE%" private const L_MsgLicenseStatusAdditionalGrace = "Additional grace period ends %ENDDATE%" private const L_MsgLicenseStatusNonGenuineGrace = "Non-genuine grace period ends %ENDDATE%" private const L_MsgLicenseStatusNotification = "Windows is in Notification mode" private const L_MsgLicenseStatusUnlicensed_1 = "License Status: Unlicensed" private const L_MsgLicenseStatusLicensed_1 = "License Status: Licensed" private const L_MsgLicenseStatusVL_1 = "Volume activation expiration: %MINUTE% minute(s) (%DAY% day(s))" private const L_MsgLicenseStatusInitialGrace_1 = "License Status: Initial grace period" private const L_MsgLicenseStatusAdditionalGrace_1 = "License Status: Additional grace period (KMS license expired or hardware out of tolerance)" private const L_MsgLicenseStatusNonGenuineGrace_1 = "License Status: Non-genuine grace period." private const L_MsgLicenseStatusNotification_1 = "License Status: Notification" private const L_MsgNotificationErrorReasonNonGenuine = "Notification Reason: 0x%ERRCODE% (non-genuine)." private const L_MsgNotificationErrorReasonExpiration = "Notification Reason: 0x%ERRCODE% (grace time expired)." private const L_MsgNotificationErrorReasonOther = "Notification Reason: 0x%ERRCODE%." private const L_MsgLicenseStatusTimeRemaining = "Time remaining: %MINUTE% minute(s) (%DAY% day(s))" private const L_MsgLicenseStatusUnknown = "License Status: Unknown" private const L_MsgLicenseStatusEvalEndData = "Evaluation End Date: " private const L_MsgReinstallingLicenses = "Re-installing license files ..." private const L_MsgLicensesReinstalled = "License files re-installed successfully." private const L_MsgServiceVersion = "Software licensing service version: " private const L_MsgProductName = "Name: " private const L_MsgProductDesc = "Description: " private const L_MsgActID = "Activation ID: " private const L_MsgAppID = "Application ID: " private const L_MsgPID4 = "Extended PID: " private const L_MsgProcessorCertUrl = "Processor Certificate URL: " private const L_MsgMachineCertUrl = "Machine Certificate URL: " private const L_MsgUseLicenseCertUrl = "Use License URL: " private const L_MsgPKeyCertUrl = "Product Key Certificate URL: " private const L_MsgPartialPKey = "Partial Product Key: " private const L_MsgErrorLicenseNotInUse = "This license is not in use." private const L_MsgKmsInfo = "Key Management Service client information" private const L_MsgCmid = "Client Machine ID (CMID): " private const L_MsgRegisteredKmsName = "Registered KMS machine name: " private const L_MsgKmsFromDnsUnavailable = "DNS auto-discovery: KMS name not available" private const L_MsgKmsFromDns = "KMS machine name from DNS: " private const L_MsgKmsPID4 = "KMS machine extended PID: " private const L_MsgActivationInterval = "Activation interval: %INTERVAL% minutes" private const L_MsgRenewalInterval = "Renewal interval: %INTERVAL% minutes" private const L_MsgKmsEnabled = "Key Management Service is enabled on this machine" private const L_MsgKmsCurrentCount = "Current count: " private const L_MsgKmsListeningOnPort = "Listening on Port: " private const L_MsgKmsPriNormal = "KMS priority: Normal" private const L_MsgKmsPriLow = "KMS priority: Low" private const L_MsgInvalidDataError = "Error: The data is invalid" private const L_MsgUndeterminedPrimaryKey = "Warning: SLMGR was not able to validate the current product key for Windows. Please upgrade to the latest service pack." private const L_MsgUndeterminedPrimaryKeyOperation = "Warning: This operation may affect more than one target license. Please verify the results." private const L_MsgUndeterminedOperationFormat = "Processing the license for %PRODUCTDESCRIPTION% (%PRODUCTID%)." private const L_MsgKmsCumulativeRequestsFromClients = "Key Management Service cumulative requests received from clients" private const L_MsgKmsTotalRequestsRecieved = "Total requests received: " private const L_MsgKmsFailedRequestsReceived = "Failed requests received: " private const L_MsgKmsRequestsWithStatusUnlicensed = "Requests with License Status Unlicensed: " private const L_MsgKmsRequestsWithStatusLicensed = "Requests with License Status Licensed: " private const L_MsgKmsRequestsWithStatusInitialGrace = "Requests with License Status Initial grace period: " private const L_MsgKmsRequestsWithStatusLicenseExpiredOrHwidOot = "Requests with License Status License expired or Hardware out of tolerance: " private const L_MsgKmsRequestsWithStatusNonGenuineGrace = "Requests with License Status Non-genuine grace period: " private const L_MsgKmsRequestsWithStatusNotification = "Requests with License Status Notification: " private const NoPrimaryKeyFound = "NoPrimaryKeyFound" private const NonKMSPrimaryKey = "NonKMSPrimaryKey" private const IndeterminatePrimaryKeyFound = "IndeterminatePrimaryKey" ' Registry constants private const HKEY_LOCAL_MACHINE = &H80000002 private const HKEY_NETWORK_SERVICE = &H80000003 private const DefaultPort = "1688" private const intKnownOption = 0 private const intUnknownOption = 1 private const SLKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\SL" private const SLKeyPath32 = "SOFTWARE\Wow6432Node\Microsoft\Windows NT\CurrentVersion\SL" private const NSKeyPath = "S-1-5-20\SOFTWARE\Microsoft\Windows NT\CurrentVersion\SL" private const HR_S_OK = 0 private const HR_ERROR_FILE_NOT_FOUND = &H80070002 private const HR_SL_E_GRACE_TIME_EXPIRED = &HC004F009 private const HR_SL_E_NOT_GENUINE = &HC004F200 ' WMI class names private const ServiceClass = "SoftwareLicensingService" private const ProductClass = "SoftwareLicensingProduct" private const WindowsAppId = "55c92734-d682-4d71-983e-d6ec3f16059f" Call ExecCommandLine() ExitScript 0 Private Sub DisplayUsage (bShowKmsInfo, bShowKmsClientInfo) LineOut GetResource("L_MsgHelp_1") LineOut GetResource("L_MsgHelp_2") LineOut " " & GetResource("L_MsgHelp_3") LineOut " " & GetResource("L_MsgHelp_4") LineOut " " & GetResource("L_MsgHelp_5") LineOut "" LineOut GetResource("L_MsgGlobalOptions") OptLine GetResource("L_optInstallProductKey"), GetResource("L_ParamsProductKey"), GetResource("L_optInstallProductKeyUsage") OptLine GetResource("L_optActivateProduct"), "", GetResource("L_optActivateProductUsage") OptLine GetResource("L_optDisplayInformation"), GetResource("L_ParamsActIDOptional"), GetResource("L_optDisplayInformationUsage") OptLine GetResource("L_optDisplayInformationVerbose"), GetResource("L_ParamsActIDOptional"), GetResource("L_optDisplayInformationUsageVerbose") OptLine GetResource("L_optExpirationDatime"), "", GetResource("L_optExpirationDatimeUsage") LineOut "" LineOut GetResource("L_MsgAdvancedOptions") OptLine GetResource("L_optClearPKeyFromRegistry"), "", GetResource("L_optClearPKeyFromRegistryUsage") OptLine GetResource("L_optInstallLicense"), GetResource("L_ParamsLicenseFile"), GetResource("L_optInstallLicenseUsage") OptLine GetResource("L_optReinstallLicenses"), "", GetResource("L_optReinstallLicensesUsage") OptLine GetResource("L_optReArmWindows"), "", GetResource("L_optReArmWindowsUsage") OptLine GetResource("L_optUninstallProductKey"), "", GetResource("L_optUninstallProductKeyUsage") If bShowKmsClientInfo = False Then OptLine GetResource("L_optDisplayIID"), "", GetResource("L_optDisplayIIDUsage") OptLine GetResource("L_optPhoneActivateProduct"), GetResource("L_ParamsPhoneActivate"), GetResource("L_optPhoneActivateProductUsage") End If LineOut "" If bShowKmsClientInfo Then LineOut GetResource("L_MsgKmsClientOptions") OptLine GetResource("L_optSetKmsName"), GetResource("L_ParamsSetKms"), GetResource("L_optSetKmsNameUsage") OptLine GetResource("L_optClearKmsName"), "", GetResource("L_optClearKmsNameUsage") End If If bShowKmsInfo Then LineOut GetResource("L_MsgKmsOptions") OptLine GetResource("L_optSetKmsListenPort"), GetResource("L_ParamsSetListenKmsPort"), GetResource("L_optSetKmsListenPortUsage") OptLine GetResource("L_optSetActivationInterval"), GetResource("L_ParamsSetActivationInterval"),GetResource("L_optSetActivationIntervalUsage") OptLine GetResource("L_optSetRenewalInterval"), GetResource("L_ParamsSetRenewalInterval"), GetResource("L_optSetRenewalIntervalUsage") OptLine GetResource("L_optSetDNS"), "", GetResource("L_optSetDNSUsage") OptLine GetResource("L_optClearDNS"), "", GetResource("L_optClearDNSUsage") OptLine GetResource("L_optSetNormalPriority"), "", GetResource("L_optSetNormalPriorityUsage") OptLine GetResource("L_optClearNormalPriority"), "", GetResource("L_optClearNormalPriorityUsage") End If ExitScript 1 End Sub Private Sub OptLine(strOption, strParams, strUsage) LineOut "-" & strOption & " " & strParams LineOut " " & strUsage End Sub Private Sub ExecCommandLine Dim bShowKmsInfo, bShowKmsClientInfo, strDescription, strPrimarySkuType Dim intOption, indexOption 'WMI connection to local provider If Not booleanConnect() Then Exit Sub End If bShowKmsInfo = False bShowKmsClientInfo = False strPrimarySkuType = GetPrimarySKUType() If (WasPrimaryKeyFound(strPrimarySkuType)) Then If (CanPrimaryKeyTypeBeDetermined(strPrimarySkuType)) Then If (IsKmsServer(strPrimarySkuType)) Then bShowKmsInfo = True ElseIf (IsKMSClient(strPrimarySkuType)) Then bShowKmsClientInfo = True End If Else 'We can't determine the primary key type! LineOut GetResource("L_MsgUndeterminedPrimaryKey") End If End If If WScript.Arguments.Count = 0 Then Call DisplayUsage(bShowKmsInfo, bShowKmsClientInfo) End If intOption = ParseCommandLine(bShowKmsInfo, bShowKmsClientInfo, 0) If intOption = intUnknownOption Then If WScript.Arguments.Count = 1 Then LineOut GetResource("L_MsgUnrecognizedOption") & WScript.Arguments.Item(0) Call DisplayUsage(bShowKmsInfo, bShowKmsClientInfo) End If If WScript.Arguments.Count <= 3 Then g_strComputer = WScript.Arguments.Item(0) indexOption = 1 Else 'assume the command line contains a machine ' name, user name and a password g_strComputer = WScript.Arguments.Item(0) g_strUserName = WScript.Arguments.Item(1) g_strPassword = WScript.Arguments.Item(2) indexOption = 3 End If 're-connect to remote machine if needed If g_strComputer <> "" Then If Not booleanConnect() Then Exit Sub End If End If 're-evaluate the type of the remote machine bShowKmsInfo = False bShowKmsClientInfo = False strPrimarySkuType = GetPrimarySKUType() If (WasPrimaryKeyFound(strPrimarySkuType)) Then If (CanPrimaryKeyTypeBeDetermined(strPrimarySkuType)) Then If (IsKmsServer(strPrimarySkuType)) Then bShowKmsInfo = True ElseIf (IsKMSClient(strPrimarySkuType)) Then bShowKmsClientInfo = True End If Else 'We can't determine the primary key type! LineOut GetResource("L_MsgUndeterminedPrimaryKey") End If End If 'try second command line param intOption = ParseCommandLine(bShowKmsInfo, bShowKmsClientInfo, indexOption) If intUnknownOption = intOption Then LineOut GetResource("L_MsgUnrecognizedOption") & WScript.Arguments.Item(indexOption) Call DisplayUsage(bShowKmsInfo, bShowKmsClientInfo) End If End If End Sub Private Function ParseCommandLine(bShowKmsInfo, bShowKmsClientInfo, index) Dim strOption, chOpt ParseCommandLine = intKnownOption strOption = LCase(WScript.Arguments.Item(index)) chOpt = Left(strOption, 1) If (chOpt <> "-") And (chOpt <> "/") Then ParseCommandLine = intUnknownOption Exit Function End If strOption = Right(strOption, Len(strOption) - 1) If strOption = GetResource("L_optInstallLicense") Then If HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, index+1, True, GetResource("L_optInstallLicense"), GetResource("L_ParamsLicenseFile")) Then InstallLicense WScript.Arguments.Item(index+1) End If ElseIf strOption = GetResource("L_optInstallProductKey") Then If HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, index+1, True, GetResource("L_optInstallProductKey"), GetResource("L_ParamsProductKey")) Then InstallProductKey WScript.Arguments.Item(index+1) End If ElseIf strOption = GetResource("L_optUninstallProductKey") Then UninstallProductKey ElseIf (strOption = GetResource("L_optDisplayIID") And bShowKmsClientInfo = False) Then DisplayIID ElseIf strOption = GetResource("L_optActivateProduct") Then ActivateProduct ElseIf (strOption = GetResource("L_optPhoneActivateProduct") And bShowKmsClientInfo = False) Then If HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, index+1, True, GetResource("L_optPhoneActivateProduct"), GetResource("L_ParamsPhoneActivate")) Then PhoneActivateProduct WScript.Arguments.Item(index+1) End If ElseIf strOption = GetResource("L_optDisplayInformation") Then If HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, index+1, False, GetResource("L_optDisplayInformation"), "") Then DisplayAllInformation WScript.Arguments.Item(index+1), False Else DisplayAllInformation "", False End If ElseIf strOption = GetResource("L_optDisplayInformationVerbose") Then If HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, index+1, False, GetResource("L_optDisplayInformationVerbose"), "") Then DisplayAllInformation WScript.Arguments.Item(index+1), True Else DisplayAllInformation "", True End If ElseIf strOption = GetResource("L_optClearPKeyFromRegistry") Then ClearPKeyFromRegistry ElseIf strOption = GetResource("L_optReinstallLicenses") Then ReinstallLicenses ElseIf strOption = GetResource("L_optReArmWindows") Then ReArmWindows() ElseIf strOption = GetResource("L_optExpirationDatime") Then ExpirationDatime() ElseIf (strOption = GetResource("L_optSetKmsName") And bShowKmsClientInfo = True) Then If HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, index+1, True, GetResource("L_optSetKmsName"), GetResource("L_ParamsSetKms")) Then SetKmsMachineName WScript.Arguments.Item(index+1) End If ElseIf (strOption = GetResource("L_optClearKmsName") And bShowKmsClientInfo = True) Then ClearKms ElseIf (strOption = GetResource("L_optSetActivationInterval") And bShowKmsInfo = True) Then If HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, index+1, True, GetResource("L_optSetActivationInterval"), GetResource("L_ParamsSetActivationInterval")) Then SetActivationInterval WScript.Arguments.Item(index+1) End If ElseIf (strOption = GetResource("L_optSetRenewalInterval") And bShowKmsInfo = True) Then If HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, index+1, True, GetResource("L_optSetRenewalInterval"), GetResource("L_ParamsSetRenewalInterval")) Then SetRenewalInterval WScript.Arguments.Item(index+1) End If ElseIf (strOption = GetResource("L_optSetKmsListenPort") And bShowKmsInfo = True) Then If HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, index+1, True, GetResource("L_optSetKmsListenPort"), GetResource("L_ParamsSetKmsListenPort")) Then SetKmsListenPort WScript.Arguments.Item(index+1) End If ElseIf (strOption = GetResource("L_optSetDNS") And bShowKmsInfo = True) Then SetDnsPublishingDisabled(False) ElseIf (strOption = GetResource("L_optClearDNS") And bShowKmsInfo = True) Then SetDnsPublishingDisabled(True) ElseIf (strOption = GetResource("L_optSetNormalPriority") And bShowKmsInfo = True) Then SetKmsLowPriority(False) ElseIf (strOption = GetResource("L_optClearNormalPriority") And bShowKmsInfo = True) Then SetKmsLowPriority(True) Else ParseCommandLine = intUnknownOption End If End Function ' global options Private Sub UninstallProductKey() Dim objProduct Dim lRet Dim iIsPrimaryWindowsSku, bAtLeastOnKeyUninstalled ' Clear the KMS version from the registry (both 64 and 32 bit locations) lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceVersion") If (lRet <> 0 And lRet <> 2) Then QuitWithError CStr(Hex(lRet)) End If lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath32, "KeyManagementServiceVersion") If (lRet <> 0 And lRet <> 2) Then QuitWithError CStr(Hex(lRet)) End If bAtLeastOnKeyUninstalled = False For Each objProduct in g_objWMIService.InstancesOf(ProductClass) iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) If ((iIsPrimaryWindowsSku = 1) Or (iIsPrimaryWindowsSku = 2)) Then If (iIsPrimaryWindowsSku = 2) Then OutputIndeterminateOperationWarning(objProduct) End If On Error Resume Next objProduct.UninstallProductKey() QuitIfError() LineOut GetResource("L_MsgUninstalledPKey") If (iIsPrimaryWindowsSku = 1) Then Exit Sub Else bAtLeastOnKeyUninstalled = True End If End If Next If (bAtLeastOnKeyUninstalled = False) Then Exit Sub End If LineOut GetResource("L_MsgErrorPKey") End Sub Private Sub DisplayIID() Dim objProduct Dim iIsPrimaryWindowsSku, bFoundAtLeastOneKey bFoundAtLeastOneKey = False For Each objProduct in g_objWMIService.InstancesOf(ProductClass) iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) If (1 = iIsPrimaryWindowsSku) Then LineOut GetResource("L_MsgInstallationID") & objProduct.OfflineInstallationId LineOut "" LineOut GetResource("L_MsgPhoneNumbers") Exit Sub ElseIf (2 = iIsPrimaryWindowsSku) Then OutputIndeterminateOperationWarning(objProduct) LineOut GetResource("L_MsgInstallationID") & objProduct.OfflineInstallationId bFoundAtLeastOneKey = TRUE End If Next If (bFoundAtLeastOneKey = TRUE) Then LineOut "" LineOut GetResource("L_MsgPhoneNumbers") Exit Sub End If LineOut GetResource("L_MsgErrorProductNotFound") End Sub Private Sub ActivateProduct() Dim objService, objProduct Dim strOutput Dim iIsPrimaryWindowsSku, bFoundAtLeastOneKey bFoundAtLeastOneKey = False For Each objService in g_objWMIService.InstancesOf(ServiceClass) For Each objProduct in g_objWMIService.InstancesOf(ProductClass) iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) If ((iIsPrimaryWindowsSku = 1) Or (iIsPrimaryWindowsSku = 2)) Then If (iIsPrimaryWindowsSku = 2) Then OutputIndeterminateOperationWarning(objProduct) End If strOutput = Replace(GetResource("L_MsgActivating"), "%PRODUCTNAME%", objProduct.Name) strOutput = Replace(strOutput, "%PRODUCTID%", objProduct.ID) LineOut strOutput On Error Resume Next objProduct.Activate() QuitIfError() objService.RefreshLicenseStatus() objProduct.refresh_ If (objProduct.LicenseStatus = 1) Then LineOut GetResource("L_MsgActivated") ElseIf (objProduct.LicenseStatus = 4) Then LineOut GetResource("L_MsgErrorText_8") & GetResource("L_MsgErrorText_11") ElseIf ((objProduct.LicenseStatus = 5) And (objProduct.LicenseStatusReason = HR_SL_E_NOT_GENUINE)) Then LineOut GetResource("L_MsgErrorText_8") & GetResource("L_MsgErrorText_12") Else LineOut GetResource("L_MsgActivated_Failed") End If If (1 = iIsPrimaryWindowsSku) Then Exit Sub Else 'Keep going in case there are other active SKUs... bFoundAtLeastOneKey = TRUE End If End If Next Next If (bFoundAtLeastOneKey = TRUE) Then Exit Sub End If LineOut GetResource("L_MsgErrorProductNotFound") End Sub Private Sub PhoneActivateProduct(strCID) Dim objService, objProduct Dim iIsPrimaryWindowsSku, bFoundAtLeastOneKey bFoundAtLeastOneKey = False For Each objService in g_objWMIService.InstancesOf(ServiceClass) For Each objProduct in g_objWMIService.InstancesOf(ProductClass) iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) If (iIsPrimaryWindowsSku = 1) Or (iIsPrimaryWindowsSku = 2) Then If (iIsPrimaryWindowsSku = 2) Then OutputIndeterminateOperationWarning(objProduct) End If On Error Resume Next objProduct.DepositOfflineConfirmationId objProduct.OfflineInstallationId, strCID QuitIfError() objService.RefreshLicenseStatus() objProduct.refresh_ If (objProduct.LicenseStatus = 1) Then strOutput = Replace(GetResource("L_MsgConfID"), "%ACTID%", objProduct.ID) LineOut strOutput ElseIf (objProduct.LicenseStatus = 4) Then LineOut GetResource("L_MsgErrorText_8") & GetResource("L_MsgErrorText_11") ElseIf ((objProduct.LicenseStatus = 5) And (objProduct.LicenseStatusReason = HR_SL_E_NOT_GENUINE)) Then LineOut GetResource("L_MsgErrorText_8") & GetResource("L_MsgErrorText_12") Else LineOut GetResource("L_MsgActivated_Failed") End If If (iIsPrimaryWindowsSku = 1) Then Exit Sub Else bFoundAtLeastOneKey = TRUE End If End If Next Next If (bFoundAtLeastOneKey = TRUE) Then Exit Sub End If LineOut GetResource("L_MsgErrorProductNotFound") End Sub Private Sub DisplayAllInformation(strParm, bVerbose) Dim objService, objProduct Dim strDescription, bKmsClient, strSLActID Dim ls, gpMin, gpDay, dwValue, displayDate Dim strKms, strPort, strOutput Dim KeyManagementServiceTotalRequests Dim iIsPrimaryWindowsSku, bUseDefault Dim strErr strParm = LCase(strParm) For Each objService in g_objWMIService.InstancesOf(ServiceClass) If bVerbose Then LineOut GetResource("L_MsgServiceVersion") & objService.Version End If For Each objProduct in g_objWMIService.InstancesOf(ProductClass) If (LCase(objProduct.ApplicationId) = WindowsAppId) Then strSLActID = objProduct.ID ' Display information if: ' parm = "all" or ' ActID = parm or ' default to current ActID (parm = "" and IsPrimaryWindowsSKU is 1 or 2) iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) bUseDefault = False If (strParm ="" And ((iIsPrimaryWindowsSku = 1) Or (iIsPrimaryWindowsSku = 2))) Then bUseDefault = True End If If (strParm = "all") Or (strParm = LCase(strSLActID)) Or (bUseDefault = True) Then strDescription = objProduct.Description 'If the user didn't specify anything and we are showing the default case, warn them ' if this can't be verified as the primary SKU If ((bUseDefault = True) And (iIsPrimaryWindowsSku = 2)) Then OutputIndeterminateOperationWarning(objProduct) End IF LineOut GetResource("L_MsgProductName") & objProduct.Name LineOut GetResource("L_MsgProductDesc") & strDescription bKmsClient = IsKmsClient(strDescription) If bVerbose Then LineOut GetResource("L_MsgActID") & strSLActID LineOut GetResource("L_MsgAppID") & objProduct.ApplicationID LineOut GetResource("L_MsgPID4") & objProduct.ProductKeyID LineOut GetResource("L_MsgInstallationID") & objProduct.OfflineInstallationId If NOT bKmsClient Then LineOut GetResource("L_MsgProcessorCertUrl") & objProduct.ProcessorURL LineOut GetResource("L_MsgMachineCertUrl") & objProduct.MachineURL LineOut GetResource("L_MsgUseLicenseCertUrl") & objProduct.UseLicenseURL LineOut GetResource("L_MsgPKeyCertUrl") & objProduct.ProductKeyURL End If End If If objProduct.PartialProductKey <> "" Then LineOut GetResource("L_MsgPartialPKey") & objProduct.PartialProductKey Else LineOut GetResource("L_MsgErrorLicenseNotInUse") End If ls = objProduct.LicenseStatus If ls = 0 Then LineOut GetResource("L_MsgLicenseStatusUnlicensed_1") ElseIf ls = 1 Then LineOut GetResource("L_MsgLicenseStatusLicensed_1") gpMin = objProduct.GracePeriodRemaining If (gpMin <> 0) Then gpDay = Int(gpMin / (24 * 60)) strOutput = Replace(GetResource("L_MsgLicenseStatusVL_1"), "%MINUTE%", gpMin) strOutput = Replace(strOutput, "%DAY%", gpDay) LineOut strOutput End If ElseIf ls = 2 Then LineOut GetResource("L_MsgLicenseStatusInitialGrace_1") gpMin = objProduct.GracePeriodRemaining gpDay = Int(gpMin / (24 * 60)) strOutput = Replace(GetResource("L_MsgLicenseStatusTimeRemaining"), "%MINUTE%", gpMin) strOutput = Replace(strOutput, "%DAY%", gpDay) LineOut strOutput ElseIf ls = 3 Then LineOut GetResource("L_MsgLicenseStatusAdditionalGrace_1") gpMin = objProduct.GracePeriodRemaining gpDay = Int(gpMin / (24 * 60)) strOutput = Replace(GetResource("L_MsgLicenseStatusTimeRemaining"), "%MINUTE%", gpMin) strOutput = Replace(strOutput, "%DAY%", gpDay) LineOut strOutput ElseIf ls = 4 Then LineOut GetResource("L_MsgLicenseStatusNonGenuineGrace_1") gpMin = objProduct.GracePeriodRemaining gpDay = Int(gpMin / (24 * 60)) strOutput = Replace(GetResource("L_MsgLicenseStatusTimeRemaining"), "%MINUTE%", gpMin) strOutput = Replace(strOutput, "%DAY%", gpDay) LineOut strOutput ElseIf ls = 5 Then LineOut GetResource("L_MsgLicenseStatusNotification_1") strErr = CStr(Hex(objProduct.LicenseStatusReason)) if (objProduct.LicenseStatusReason = HR_SL_E_NOT_GENUINE) Then strOutput = Replace(GetResource("L_MsgNotificationErrorReasonNonGenuine"), "%ERRCODE%", strErr) ElseIf (objProduct.LicenseStatusReason = HR_SL_E_GRACE_TIME_EXPIRED) Then strOutput = Replace(GetResource("L_MsgNotificationErrorReasonExpiration"), "%ERRCODE%", strErr) Else strOutput = Replace(GetResource("L_MsgNotificationErrorReasonOther"), "%ERRCODE%", strErr) End If LineOut strOutput Else LineOut GetResource("L_MsgLicenseStatusUnknown") End If If (ls <> 0 And bVerbose) Then Set displayDate = CreateObject("WBemScripting.SWbemDateTime") displayDate.Value = objProduct.EvaluationEndDate If (displayDate.GetFileTime(false) <> 0) Then LineOut GetResource("L_MsgLicenseStatusEvalEndData") & displayDate.GetVarDate End If End If ' ' KMS client properties ' If bKmsClient Then LineOut "" LineOut GetResource("L_MsgKmsInfo") LineOut " " & GetResource("L_MsgCmid") & objService.ClientMachineID strKms = objService.KeyManagementServiceMachine if Not IsNull(strKms) Then strPort = strGetRegistry(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServicePort") If (IsNull(strPort) Or strPort = "") Then strPort = DefaultPort End If LineOut " " & GetResource("L_MsgRegisteredKmsName") & strKms & ":" & strPort Else strKms = strGetRegistry(HKEY_NETWORK_SERVICE, NSKeyPath, "DiscoveredKeyManagementServiceName") strPort = strGetRegistry(HKEY_NETWORK_SERVICE, NSKeyPath, "DiscoveredKeyManagementServicePort") If IsNull(strKms) Or IsNull(strPort) Then LineOut " " & GetResource("L_MsgKmsFromDnsUnavailable") Else LineOut " " & GetResource("L_MsgKmsFromDns") & strKms & ":" & strPort End If End If LineOut " " & GetResource("L_MsgKmsPID4") & objService.KeyManagementServiceProductKeyID strOutput = Replace(GetResource("L_MsgActivationInterval"), "%INTERVAL%", objService.VLActivationInterval) LineOut " " & strOutput strOutput = Replace(GetResource("L_MsgRenewalInterval"), "%INTERVAL%", objService.VLRenewalInterval) LineOut " " & strOutput End If 'We should stop processing if we aren't processing All and either we were told to process a single 'entry only or we found the primary SKU If strParm <> "all" Then If (strParm = LCase(strSLActID)) Or (iIsPrimaryWindowsSku = 1) Then Exit For 'no need to continue End If End If LineOut "" End If End If Next If objService.IsKeyManagementServiceMachine > 0 Then LineOut "" LineOut GetResource("L_MsgKmsEnabled") LineOut " " & GetResource("L_MsgKmsCurrentCount") & objService.KeyManagementServiceCurrentCount strValue = strGetRegistry(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceListeningPort") If IsNull(strValue) Then LineOut " " & GetResource("L_MsgKmsListeningOnPort") & DefaultPort Else LineOut " " & GetResource("L_MsgKmsListeningOnPort") & strValue End If dwValue = dwGetRegistry(HKEY_LOCAL_MACHINE, SLKeyPath, "DisableDnsPublishing") If IsNull(dwValue) Or dwValue = 0 Then LineOut " " & GetResource("L_MsgKmsDnsPublishingEnabled") Else LineOut " " & GetResource("L_MsgKmsDnsPublishingDisabled") End If dwValue = dwGetRegistry(HKEY_LOCAL_MACHINE, SLKeyPath, "EnableKmsLowPriority") If IsNull(dwValue) Or dwValue = 0 Then LineOut " " & GetResource("L_MsgKmsPriNormal") Else LineOut " " & GetResource("L_MsgKmsPriLow") End If On Error Resume Next KeyManagementServiceTotalRequests = objService.KeyManagementServiceTotalRequests If (Not(IsNull(KeyManagementServiceTotalRequests))) And (Not(IsEmpty(KeyManagementServiceTotalRequests))) Then LineOut "" LineOut GetResource("L_MsgKmsCumulativeRequestsFromClients") LineOut " " & GetResource("L_MsgKmsTotalRequestsRecieved") & objService.KeyManagementServiceTotalRequests LineOut " " & GetResource("L_MsgKmsFailedRequestsReceived") & objService.KeyManagementServiceFailedRequests LineOut " " & GetResource("L_MsgKmsRequestsWithStatusUnlicensed") & objService.KeyManagementServiceUnlicensedRequests LineOut " " & GetResource("L_MsgKmsRequestsWithStatusLicensed") & objService.KeyManagementServiceLicensedRequests LineOut " " & GetResource("L_MsgKmsRequestsWithStatusInitialGrace") & objService.KeyManagementServiceOOBGraceRequests LineOut " " & GetResource("L_MsgKmsRequestsWithStatusLicenseExpiredOrHwidOot") & objService.KeyManagementServiceOOTGraceRequests LineOut " " & GetResource("L_MsgKmsRequestsWithStatusNonGenuineGrace") & objService.KeyManagementServiceNonGenuineGraceRequests LineOut " " & GetResource("L_MsgKmsRequestsWithStatusNotification") & objService.KeyManagementServiceNotificationRequests End If End If Next End Sub Private Sub InstallProductKey(strProductKey) Dim objService, objProduct Dim lRet, strDescription, strOutput Dim iIsPrimaryWindowsSku, bIsKMS bIsKMS = False For Each objService in g_objWMIService.InstancesOf(ServiceClass) On Error Resume Next objService.InstallProductKey(strProductKey) QuitIfError() For Each objProduct in g_objWMIService.InstancesOf(ProductClass) iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) If (iIsPrimaryWindowsSku = 1) Or (iIsPrimaryWindowsSku = 2) Then strDescription = objProduct.Description If (iIsPrimaryWindowsSku = 2) Then OutputIndeterminateOperationWarning(objProduct) End If If IsKmsServer(strDescription) Then ' Set the KMS version in the registry (64 and 32 bit versions) lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceVersion", objService.Version) If (lRet <> 0) Then QuitWithError CStr(Hex(lRet)) End If If ExistsRegistryKey(HKEY_LOCAL_MACHINE, SLKeyPath32) Then lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath32, "KeyManagementServiceVersion", objService.Version) If (lRet <> 0) Then QuitWithError CStr(Hex(lRet)) End If End If bIsKMS = True 'Only clear the KMS entry if we aren't a KMS. We may be KMS but have a secondary key from an add-on ElseIf (bIsKMS = False) Then lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceVersion") If (lRet <> 0 And lRet <> 2 And lRet <> 5) Then QuitWithError CStr(Hex(lRet)) End If lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath32, "KeyManagementServiceVersion") If (lRet <> 0 And lRet <> 2 And lRet <> 5) Then QuitWithError CStr(Hex(lRet)) End If End If End If Next QuitIfError() Next strOutput = Replace(GetResource("L_MsgInstalledPKey"), "%PKEY%", strProductKey) LineOut strOutput End Sub Private Sub OutputIndeterminateOperationWarning(objProduct) Dim strOutput LineOut GetResource("L_MsgUndeterminedPrimaryKeyOperation") strOutput = Replace(GetResource("L_MsgUndeterminedOperationFormat"), "%PRODUCTDESCRIPTION%", objProduct.Description) strOutput = Replace(strOutput, "%PRODUCTID%", objProduct.ID) LineOut strOutput End Sub Private Sub ClearPKeyFromRegistry() Dim objService For Each objService in g_objWMIService.InstancesOf(ServiceClass) On Error Resume Next objService.ClearProductKeyFromRegistry() QuitIfError() Next LineOut GetResource("L_MsgClearedPKey") End Sub Private Sub InstallLicenseFiles (strParentDirectory, fso) Dim file, files, folder, subFolder Set folder = fso.GetFolder(strParentDirectory) Set files = folder.Files ' Install all license files in folder For Each file In files If Right(file.Name, 7) = ".xrm-ms" Then InstallLicense strParentDirectory & "\" & file.Name End If Next For Each subFolder in folder.SubFolders InstallLicenseFiles subFolder, fso Next End Sub Private Sub ReinstallLicenses() Dim shell, fso, strOemFolder Set shell = WScript.CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") strOemFolder = shell.ExpandEnvironmentStrings("%SystemRoot%") & "\system32\oem" LineOut GetResource("L_MsgReinstallingLicenses") InstallLicenseFiles shell.ExpandEnvironmentStrings("%SystemRoot%") & "\system32\licensing", fso If (fso.FolderExists(strOemFolder)) Then InstallLicenseFiles strOemFolder, fso End If LineOut GetResource("L_MsgLicensesReinstalled") End Sub Private Sub ReArmWindows Dim objService For Each objService in g_objWMIService.InstancesOf(ServiceClass) On Error Resume Next objService.ReArmWindows() QuitIfError() Next LineOut GetResource("L_MsgRearm_1") LineOut GetResource("L_MsgRearm_2") End Sub Private Sub ExpirationDatime Dim objProduct Dim strSLActID, ls, graceRemaining, strEnds, strOutput Dim iIsPrimaryWindowsSku For Each objProduct in g_objWMIService.InstancesOf(ProductClass) iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) If (iIsPrimaryWindowsSku = 1) Or (iIsPrimaryWindowsSku = 2) Then strSLActID = objProduct.ID ls = objProduct.LicenseStatus graceRemaining = objProduct.GracePeriodRemaining strEnds = DateAdd("n", graceRemaining, Now) If (iIsPrimaryWindowsSku = 2) Then OutputIndeterminateOperationWarning(objProduct) End If If ls = 0 Then LineOut GetResource("L_MsgLicenseStatusUnlicensed") ElseIf ls = 1 Then If graceRemaining <> 0 Then strOutput = Replace(GetResource("L_MsgLicenseStatusVL"), "%ENDDATE%", strEnds) LineOut strOutput Else LineOut GetResource("L_MsgLicenseStatusLicensed") End If ElseIf ls = 2 Then strOutput = Replace(GetResource("L_MsgLicenseStatusInitialGrace"), "%ENDDATE%", strEnds) LineOut strOutput ElseIf ls = 3 Then strOutput = Replace(GetResource("L_MsgLicenseStatusAdditionalGrace"), "%ENDDATE%", strEnds) LineOut strOutput ElseIf ls = 4 Then strOutput = Replace(GetResource("L_MsgLicenseStatusNonGenuineGrace"), "%ENDDATE%", strEnds) LineOut strOutput ElseIf ls = 5 Then LineOut GetResource("L_MsgLicenseStatusNotification") End If End If Next End Sub ' volume license service/client management Private Sub SetKmsMachineName(strKmsNamePort) Dim objService Dim nColon, strKmsName, strKmsPort, lRet, strOutput nColon = InStr(1, strKmsNamePort, ":") If nColon <> 0 Then strKmsName = Left(strKmsNamePort, nColon - 1) strKmsPort = Right(strKmsNamePort, Len(strKmsNamePort) - nColon) Else strKmsName = strKmsNamePort strKmsPort = "" End If If strKmsName <> "" Then For Each objService in g_objWMIService.InstancesOf(ServiceClass) On Error Resume Next objService.SetKeyManagementServiceMachine(strKmsName) QuitIfError() Next End If On Error Resume Next lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServicePort", strKmsPort) If (lRet <> 0) Then QuitWithError CStr(Hex(lRet)) End If strOutput = Replace(GetResource("L_MsgKmsNameSet"), "%KMS%", strKmsNamePort) LineOut strOutput End Sub Private Sub ClearKms() Dim objService Dim lRet For Each objService in g_objWMIService.InstancesOf(ServiceClass) On Error Resume Next objService.ClearKeyManagementServiceMachine() If (Err.Number <> HR_S_OK And Err.Number <> HR_ERROR_FILE_NOT_FOUND) Then QuitWithError CStr(Hex(Err.Number)) End If Next On Error Resume Next lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServicePort", DefaultPort) If (lRet <> 0) Then QuitWithError CStr(Hex(lRet)) End If LineOut GetResource("L_MsgKmsNameCleared") End Sub Private Sub SetActivationInterval(intInterval) Dim objService Dim kmsFlag, strOutput If (intInterval < 0) Then LineOut GetResource("L_MsgInvalidDataError") Exit Sub End If For Each objService in g_objWMIService.InstancesOf(ServiceClass) kmsFlag = objService.IsKeyManagementServiceMachine If kmsFlag Then On Error Resume Next objService.SetVLActivationInterval(intInterval) QuitIfError() strOutput = Replace(GetResource("L_MsgActivationSet"), "%ACTIVATION%", intInterval) LineOut strOutput LineOut GetResource("L_MsgWarningKmsReboot") Else LineOut GetResource("L_MsgWarningActivation") End If Next End Sub Private Sub SetRenewalInterval(intInterval) Dim objService Dim kmsFlag, strOutput If (intInterval < 0) Then LineOut GetResource("L_MsgInvalidDataError") Exit Sub End If For Each objService in g_objWMIService.InstancesOf(ServiceClass) kmsFlag = objService.IsKeyManagementServiceMachine If kmsFlag Then On Error Resume Next objService.SetVLRenewalInterval(intInterval) QuitIfError() strOutput = Replace(GetResource("L_MsgRenewalSet"), "%RENEWAL%", intInterval) LineOut strOutput LineOut GetResource("L_MsgWarningKmsReboot") Else LineOut GetResource("L_MsgWarningRenewal") End If Next End Sub Private Sub SetKmsListenPort(strPort) Dim objService Dim kmsFlag, strOutput For Each objService in g_objWMIService.InstancesOf(ServiceClass) kmsFlag = objService.IsKeyManagementServiceMachine If kmsFlag Then On Error Resume Next lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceListeningPort", strPort) If (lRet <> 0) Then QuitWithError CStr(Hex(lRet)) End If strOutput = Replace(GetResource("L_MsgKmsPortSet"), "%PORT%", strPort) LineOut strOutput LineOut GetResource("L_MsgWarningKmsReboot") Else LineOut GetResource("L_MsgWarningKmsPort") End If Next End Sub Private Sub SetDnsPublishingDisabled(bool) Dim objService Dim kmsFlag, lRet, dwValue For Each objService in g_objWMIService.InstancesOf(ServiceClass) kmsFlag = objService.IsKeyManagementServiceMachine If kmsFlag Then On Error Resume Next If bool Then dwValue = 1 Else dwValue = 0 End If lRet = SetRegistryDw(HKEY_LOCAL_MACHINE, SLKeyPath, "DisableDnsPublishing", dwValue) If (lRet <> 0) Then QuitWithError CStr(Hex(lRet)) End If If bool Then LineOut GetResource("L_MsgKmsDnsPublishingDisabled") Else LineOut GetResource("L_MsgKmsDnsPublishingEnabled") End If LineOut GetResource("L_MsgWarningKmsReboot") Else LineOut GetResource("L_MsgKmsDnsPublishingWarning") End If Next End Sub Private Sub SetKmsLowPriority(bool) Dim objService Dim kmsFlag, dwValue For Each objService in g_objWMIService.InstancesOf(ServiceClass) kmsFlag = objService.IsKeyManagementServiceMachine If kmsFlag Then On Error Resume Next If bool Then dwValue = 1 Else dwValue = 0 End If lRet = SetRegistryDw(hKey_LOCAL_MACHINE, SLKeyPath, "EnableKmsLowPriority", dwValue) If (lRet <> 0) Then QuitWithError CStr(Hex(lRet)) End If If bool Then LineOut GetResource("L_MsgKmsPriSetToLow") Else LineOut GetResource("L_MsgKmsPriSetToNormal") End If LineOut GetResource("L_MsgWarningKmsReboot") Else LineOut GetResource("L_MsgWarningKmsPri") End If Next End Sub ' other generic options/helpers Private Sub LineOut(str) g_EchoString = g_EchoString & str & vbNewLine End Sub Private Sub ExitScript(retval) WScript.Echo g_EchoString WScript.Quit retval End Sub Private Sub InstallLicense(licFile) Dim objService Dim LicenseData On Error Resume Next LicenseData = ReadAllTextFile(licFile) QuitIfError() For Each objService in g_objWMIService.InstancesOf(ServiceClass) objService.InstallLicense(LicenseData) QuitIfError() Next strOutput = Replace(GetResource("L_MsgLicenseFile"), "%LICENSEFILE%", licFile) LineOut strOutput LineOut "" End Sub ' Returns the encoding for a givven file. ' Possible return values: ascii, unicode, unicodeFFFE (big-endian), utf-8 Function GetFileEncoding(strFileName) Dim strData Dim strEncoding Set oStream = CreateObject("ADODB.Stream") oStream.Type = 1 'adTypeBinary oStream.Open oStream.LoadFromFile(strFileName) ' Default encoding is ascii strEncoding = "ascii" strData = BinaryToString(oStream.Read(2)) ' Check for little endian (x86) unicode preamble If (Len(strData) = 2) and strData = (Chr(255) + Chr(254)) Then strEncoding = "unicode" Else oStream.Position = 0 strData = BinaryToString(oStream.Read(3)) ' Check for utf-8 preamble If (Len(strData) >= 3) and strData = (Chr(239) + Chr(187) + Chr(191)) Then strEncoding = "utf-8" End If End If oStream.Close GetFileEncoding = strEncoding End Function ' Converts binary data (VT_UI1 | VT_ARRAY) to a string (BSTR) Function BinaryToString(dataBinary) Dim i Dim str For i = 1 To LenB(dataBinary) str = str & Chr(AscB(MidB(dataBinary, i, 1))) Next BinaryToString = str End Function ' Returns string containing the whole text file data. ' Supports ascii, unicode (little-endian) and utf-8 encoding. Function ReadAllTextFile(strFileName) Dim strData Set oStream = CreateObject("ADODB.Stream") oStream.Type = 2 'adTypeText oStream.Open oStream.Charset = GetFileEncoding(strFileName) oStream.LoadFromFile(strFileName) strData = oStream.ReadText(-1) 'adReadAll oStream.Close ReadAllTextFile = strData End Function Private Function HandleOptionParam(bShowKmsInfo, bShowKmsClientInfo, cParam, mustProvide, opt, param) Dim strOutput HandleOptionParam = True If WScript.Arguments.Count <= cParam Then HandleOptionParam = False If mustProvide Then LineOut "" strOutput = Replace(GetResource("L_MsgErrorText_9"), "%OPTION%", opt) strOutput = Replace(strOutput, "%PARAM%", param) LineOut strOutput Call DisplayUsage(bShowKmsInfo, bShowKmsClientInfo) End If End If End Function Private Sub ShowErrorNum(strMessage, strErrNum) Dim strOutput Select Case strErrNum Case "5": strErrText = GetResource("L_MsgErrorText_1") Case "80070005": strErrText = GetResource("L_MsgErrorText_1") Case "C004F025": strErrText = GetResource("L_MsgErrorText_1") Case "8007232A": strErrText = GetResource("L_MsgErrorText_2") Case "C004F012": strErrText = GetResource("L_MsgErrorText_3") Case "C004F038": strErrText = GetResource("L_MsgErrorText_4") Case "C004F039": strErrText = GetResource("L_MsgErrorText_5") Case "C004D307": strErrText = GetResource("L_MsgErrorText_10") Case Else strOutput = Replace(GetResource("L_MsgErrorText_6"), "%ERRCODE%", strErrNum) LineOut strOutput End Select LineOut strMessage & "0x" & strErrNum & " " & strErrText End Sub Private Sub QuitIfError() If Err.Number <> 0 Then ShowErrorNum GetResource("L_MsgErrorText_8"), Hex(Err.Number) ExitScript 1 End If End Sub Private Sub QuitWithError(strErrNum) ShowErrorNum GetResource("L_MsgErrorText_8"), strErrNum ExitScript 1 End Sub Private Function booleanConnect() On Error Resume Next Dim objLocator, strOutput Dim objServer Dim objProcServer, objProc Dim strErr booleanConnect = True 'There is no error. 'If this is the local computer, set everything and return immediately If g_strComputer = "." Then Set g_objWMIService = GetObject("winmgmts:\\" & g_strComputer & "\root\cimv2") Set g_objRegistry = GetObject("winmgmts:\\" & g_strComputer & "\root\default:StdRegProv") Set objProc = GetObject("winmgmts:\\" & g_strComputer & "\root\cimv2:Win32_Processor='cpu0'") strErr = CStr(Hex(Err.Number)) If Err.Number <> 0 Then strOutput = Replace(GetResource("L_MsgErrorConnectionProcessor"), "%ERRCODE%", strErr) strOutput = Replace(strOutput, "%COMPUTERNAME%", g_strComputer) LineOut strOutput If Err.Description <> "" Then LineOut GetResource("L_MsgErrorDescription") & Err.Description & "." End If Err.Clear booleanConnect = False 'An error occurred Exit Function End If GetProcessorArchitecture(objProc) If Not g_serviceConnected Then g_serviceConnected = True End If Exit Function End If 'Otherwise, establish the remote object connections ' Create Locator object to connect to remote CIM object manager Set objLocator = CreateObject("WbemScripting.SWbemLocator") strErr = CStr(Hex(Err.Number)) If Err.Number <> 0 Then strOutput = Replace(GetResource("L_MsgErrorWMI"), "%ERRCODE%", strErr) LineOut strOutput If Err.Description <> "" Then LineOut GetResource("L_MsgErrorDescription") & Err.Description & "." End If Err.Clear booleanConnect = False 'An error occurred Exit Function End If ' Connect to the namespace which is either local or remote Set g_objWMIService = objLocator.ConnectServer (g_strComputer, "\root\cimv2", g_strUserName, g_strPassword) strErr = CStr(Hex(Err.Number)) If Err.Number <> 0 Then strOutput = Replace(GetResource("L_MsgErrorConnection"), "%ERRCODE%", strErr) strOutput = Replace(strOutput, "%COMPUTERNAME%", g_strComputer) LineOut strOutput If Err.Description <> "" Then LineOut GetResource("L_MsgErrorDescription") & Err.Description & "." End If Err.Clear booleanConnect = False 'An error occurred Exit Function End If g_objWMIService.Security_.impersonationlevel = 3 strErr = CStr(Hex(Err.Number)) If Err.Number <> 0 Then strOutput = Replace(GetResource("L_MsgErrorImpersonation"), "%ERRCODE%", strErr) LineOut strOutput If Err.Description <> "" Then LineOut GetResource("L_MsgErrorDescription") & Err.Description & "." End If Err.Clear booleanConnect = False 'An error occurred Exit Function End If Set objServer = objLocator.ConnectServer(g_strComputer, "\root\default:StdRegProv", g_strUserName, g_strPassword) strErr = CStr(Hex(Err.Number)) If Err.Number <> 0 Then strOutput = Replace(GetResource("L_MsgErrorConnectionRegistry"), "%ERRCODE%", strErr) strOutput = Replace(strOutput, "%COMPUTERNAME%", g_strComputer) LineOut strOutput If Err.Description <> "" Then LineOut GetResource("L_MsgErrorDescription") & Err.Description & "." End If Err.Clear booleanConnect = False 'An error occurred Exit Function End If objServer.Security_.ImpersonationLevel = 3 Set g_objRegistry = objServer.Get("StdRegProv") strErr = CStr(Hex(Err.Number)) If Err.Number <> 0 Then strOutput = Replace(GetResource("L_MsgErrorConnectionRegistry"), "%ERRCODE%", strErr) strOutput = Replace(strOutput, "%COMPUTERNAME%", g_strComputer) LineOut strOutput If Err.Description <> "" Then LineOut GetResource("L_MsgErrorDescription") & Err.Description & "." End If Err.Clear booleanConnect = False 'An error occurred Exit Function End If Set objProcServer = objLocator.ConnectServer(g_strComputer, "\root\cimv2:Win32_Processor='cpu0'", g_strUserName, g_strPassword) strErr = CStr(Hex(Err.Number)) If Err.Number <> 0 Then strOutput = Replace(GetResource("L_MsgErrorConnectionProcessor"), "%ERRCODE%", strErr) strOutput = Replace(strOutput, "%COMPUTERNAME%", g_strComputer) LineOut strOutput If Err.Description <> "" Then LineOut GetResource("L_MsgErrorDescription") & Err.Description & "." End If Err.Clear booleanConnect = False 'An error occurred Exit Function End If Set objProc = objProcServer.Get("Win32_Processor='cpu0'") strErr = CStr(Hex(Err.Number)) If Err.Number <> 0 Then strOutput = Replace(GetResource("L_MsgErrorConnectionProcessor"), "%ERRCODE%", strErr) strOutput = Replace(strOutput, "%COMPUTERNAME%", g_strComputer) LineOut strOutput If Err.Description <> "" Then LineOut GetResource("L_MsgErrorDescription") & Err.Description & "." End If Err.Clear booleanConnect = False 'An error occurred Exit Function End If GetProcessorArchitecture(objProc) If Not g_serviceConnected Then g_serviceConnected = True End If End Function Private Function IsKmsClient(strDescription) If InStr(strDescription, "VOLUME_KMSCLIENT") > 0 Then IsKmsClient = True Else IsKmsClient = False End If End Function Private Function IsKmsServer(strDescription) If IsKmsClient(strDescription) Then IsKmsServer = False Else If InStr(strDescription, "VOLUME_KMS") > 0 Then IsKmsServer = True Else IsKmsServer = False End If End If End Function 'Returns 0 if this is not the primary SKU, 1 if it is, and 2 if we aren't certain (older clients) Function GetIsPrimaryWindowsSKU(objProduct) Dim iPrimarySku Dim bIsAddOn 'Assume this is not the primary SKU iPrimarySku = 0 'Verify the license is for Windows, that it has a partial key, and that If (LCase(objProduct.ApplicationId) = WindowsAppId And objProduct.PartialProductKey <> "") Then 'If we can get verify the AddOn property then we can be certain On Error Resume Next bIsAddOn = objProduct.LicenseIsAddon If Err.Number = 0 Then If bIsAddOn = true Then iPrimarySku = 0 Else iPrimarySku = 1 End If Else 'If we can not get the AddOn property then we assume this is a previous version 'and we return a value of Uncertain, unless we can prove otherwise If (IsKmsClient(objProduct.Description) Or IsKmsServer(objProduct.Description)) Then 'If the description is KMS related, we can be certain that this is a primary SKU iPrimarySku = 1 Else 'Indeterminate since the property was missing and we can't verify KMS iPrimarySku = 2 End If End If End If GetIsPrimaryWindowsSKU = iPrimarySku End Function Private Function WasPrimaryKeyFound(strPrimarySkuType) If (IsKmsServer(strPrimarySkuType) Or IsKmsClient(strPrimarySkuType) Or (InStr(strPrimarySkuType, NonKMSPrimaryKey) > 0) Or (InStr(strPrimarySkuType, IndeterminatePrimaryKeyFound) > 0)) Then WasPrimaryKeyFound = True Else WasPrimaryKeyFound = False End If End Function Private Function CanPrimaryKeyTypeBeDetermined(strPrimarySkuType) If ((InStr(strPrimarySkuType, IndeterminatePrimaryKeyFound) > 0) Or (InStr(strPrimarySkuType, NoPrimaryKeyFound) > 0)) Then CanPrimaryKeyTypeBeDetermined = False Else CanPrimaryKeyTypeBeDetermined = True End If End Function Private Function GetPrimarySKUType() Dim objService, objProduct Dim strPrimarySKUType, strDescription Dim iIsPrimaryWindowsSku For Each objService in g_objWMIService.InstancesOf(ServiceClass) For Each objProduct in g_objWMIService.InstancesOf(ProductClass) iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct) If (iIsPrimaryWindowsSku = 1) Then strDescription = objProduct.Description If (IsKmsServer(strDescription) Or IsKmsClient(strDescription)) Then strPrimarySKUType = strDescription Else strPrimarySKUType = NonKMSPrimaryKey End If Exit For 'no need to continue ElseIf ((iIsPrimaryWindowsSku = 2) And strPrimarySKUType = "") Then strPrimarySKUType = IndeterminatePrimaryKeyFound End If Next Next If strPrimarySKUType = "" Then strPrimarySKUType = NoPrimaryKeyFound End If GetPrimarySKUType = strPrimarySKUType End Function ' Registry operations Private Function dwGetRegistry(hKey, strKeyPath, strValueName) g_objRegistry.GetDwordValue hKey, strKeyPath, strValueName, dwGetRegistry End Function Private Function strGetRegistry(hKey, strKeyPath, strValueName) g_objRegistry.GetStringValue hKey, strKeyPath, strValueName, strGetRegistry End Function Private Function SetRegistryDw(hKey, strKeyPath, strValueName, dwValue) SetRegistryDw = g_objRegistry.SetDwordValue(hKey, strKeyPath, strValueName, dwValue) End Function Private Function SetRegistryStr(hKey, strKeyPath, strValueName, strValue) SetRegistryStr = g_objRegistry.SetStringValue(hKey, strKeyPath, strValueName, strValue) End Function Private Function DeleteRegistryValue(hKey, strKeyPath, strValueName) DeleteRegistryValue = g_objRegistry.DeleteValue(hKey, strKeyPath, strValueName) End Function Private Function ExistsRegistryKey(hKey, strKeyPath) Dim bGranted Dim lRet ' Check for KEY_QUERY_VALUE for this key lRet = g_objRegistry.CheckAccess(hKey, strKeyPath, 1, bGranted) ' Ignore real access rights, just look for existence of the key If lRet<>2 Then ExistsRegistryKey = True Else ExistsRegistryKey = False End If End Function ' Resource manipulation ' Get the resource string with the given name from the locale specific ' dictionary. If not found, use the built-in default. Private Function GetResource(name) LoadResourceData If g_resourceDictionary.Exists(name) Then GetResource = g_resourceDictionary.Item(name) Else GetResource = Eval(name) End If End Function ' Loads resource strings from an ini file of the appropriate locale Private Function LoadResourceData If g_resourcesLoaded Then Exit Function End If Dim lang, value, ini Dim fso Set fso = WScript.CreateObject("Scripting.FileSystemObject") On Error Resume Next lang = GetUILanguage() If Err.Number <> 0 Then 'API does not exist prior to Vista so no resources to load g_resourcesLoaded = True Exit Function End If ini = fso.GetParentFolderName(WScript.ScriptFullName) & "\slmgr\" _ & ToHex(lang) & "\" & fso.GetBaseName(WScript.ScriptName) & ".ini" If fso.FileExists(ini) Then Dim stream, file Const ForReading = 1, TristateTrue = -1 'Read file in unicode format Set stream = fso.OpenTextFile(ini, ForReading, False, TristateTrue) ReadResources(stream) stream.Close End If g_resourcesLoaded = True End Function ' Reads resource strings from an ini file Private Function ReadResources(stream) const ERROR_FILE_NOT_FOUND = 2 Dim ln, arr, key, value If Not IsObject(stream) Then Err.Raise ERROR_FILE_NOT_FOUND Do Until stream.AtEndOfStream ln = stream.ReadLine arr = Split(ln, "=", 2, 1) If UBound(arr, 1) = 1 Then ' Trim the key and the value first before trimming quotes key = Trim(arr(0)) value = TrimChar(Trim(arr(1)), """") If key <> "" Then g_resourceDictionary.Add key, value End If End If Loop End Function ' Trim a character from the text string Private Function TrimChar(s, c) Const vbTextCompare = 1 ' Trim character from the start If InStr(1, s, c, vbTextCompare) = 1 Then s = Mid(s, 2) End If ' Trim character from the end If InStr(Len(s), s, c, vbTextCompare) = Len(s) Then s = Mid(s, 1, Len(s) - 1) End If TrimChar = s End Function ' Get a 4-digit hexadecimal number Private Function ToHex(n) Dim s : s = Hex(n) ToHex = String(4 - Len(s), "0") & s End Function