API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Sep 17th, 2017
804
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 139.55 KB | None | 0 0
raw download clone embed print report
  1. '
  2. ' Copyright (c) Microsoft Corporation. All rights reserved.
  3. '
  4. ' Windows Software Licensing Management Tool.
  5. '
  6. ' Script Name: slmgr.vbs
  7. '
  8.  
  9. Option Explicit
  10.  
  11. Dim g_objWMIService, g_strComputer, g_strUserName, g_strPassword, g_IsRemoteComputer
  12. g_strComputer = "."
  13. g_IsRemoteComputer = False
  14.  
  15. dim g_EchoString
  16. g_EchoString = ""
  17.  
  18. dim g_objRegistry
  19.  
  20. Dim g_resourceDictionary, g_resourcesLoaded
  21. Set g_resourceDictionary = CreateObject("Scripting.Dictionary")
  22. g_resourcesLoaded = False
  23.  
  24. Dim g_DeterminedDisplayFlags
  25. g_DeterminedDisplayFlags = False
  26.  
  27. Dim g_ShowKmsInfo
  28. Dim g_ShowKmsClientInfo
  29. Dim g_ShowTkaClientInfo
  30. Dim g_ShowTBLInfo
  31. Dim g_ShowPhoneInfo
  32.  
  33. g_ShowKmsInfo = False
  34. g_ShowKmsClientInfo = false
  35. g_ShowTBLInfo = False
  36. g_ShowPhoneInfo = False
  37.  
  38. ' Messages
  39.  
  40. 'Global options
  41. private const L_optInstallProductKey = "ipk"
  42. private const L_optInstallProductKeyUsage = "Install product key (replaces existing key)"
  43.  
  44. private const L_optUninstallProductKey = "upk"
  45. private const L_optUninstallProductKeyUsage = "Uninstall product key"
  46.  
  47. private const L_optActivateProduct = "ato"
  48. private const L_optActivateProductUsage = "Activate Windows"
  49.  
  50. private const L_optDisplayInformation = "dli"
  51. private const L_optDisplayInformationUsage = "Display license information (default: current license)"
  52.  
  53. private const L_optDisplayInformationVerbose = "dlv"
  54. private const L_optDisplayInformationUsageVerbose = "Display detailed license information (default: current license)"
  55.  
  56. private const L_optExpirationDatime = "xpr"
  57. private const L_optExpirationDatimeUsage = "Expiration date for current license state"
  58.  
  59. 'Advanced options
  60. private const L_optClearPKeyFromRegistry = "cpky"
  61. private const L_optClearPKeyFromRegistryUsage = "Clear product key from the registry (prevents disclosure attacks)"
  62.  
  63. private const L_optInstallLicense = "ilc"
  64. private const L_optInstallLicenseUsage = "Install license"
  65.  
  66. private const L_optReinstallLicenses = "rilc"
  67. private const L_optReinstallLicensesUsage = "Re-install system license files"
  68.  
  69. private const L_optDisplayIID = "dti"
  70. private const L_optDisplayIIDUsage = "Display Installation ID for offline activation"
  71.  
  72. private const L_optPhoneActivateProduct = "atp"
  73. private const L_optPhoneActivateProductUsage = "Activate product with user-provided Confirmation ID"
  74.  
  75. private const L_optReArmWindows = "rearm"
  76. private const L_optReArmWindowsUsage = "Reset the licensing status of the machine"
  77.  
  78. private const L_optReArmApplication = "rearm-app"
  79. private const L_optReArmApplicationUsage = "Reset the licensing status of the given app"
  80.  
  81. private const L_optReArmSku = "rearm-sku"
  82. private const L_optReArmSkuUsage = "Reset the licensing status of the given sku"
  83.  
  84. 'KMS options
  85.  
  86. private const L_optSetKmsName = "skms"
  87. private const L_optSetKmsNameUsage = "Set the name and/or the port for the KMS computer this machine will use. IPv6 address must be specified in the format [hostname]:port"
  88.  
  89. private const L_optClearKmsName = "ckms"
  90. private const L_optClearKmsNameUsage = "Clear name of KMS computer used (sets the port to the default)"
  91.  
  92. private const L_optSetKmsLookupDomain = "skms-domain"
  93. private const L_optSetKmsLookupDomainUsage = "Set the specific DNS domain in which all KMS SRV records can be found. This setting has no effect if the specific single KMS host is set via /skms option."
  94.  
  95. private const L_optClearKmsLookupDomain = "ckms-domain"
  96. private const L_optClearKmsLookupDomainUsage = "Clear the specific DNS domain in which all KMS SRV records can be found. The specific KMS host will be used if set via /skms. Otherwise default KMS auto-discovery will be used."
  97.  
  98. private const L_optSetKmsHostCaching = "skhc"
  99. private const L_optSetKmsHostCachingUsage = "Enable KMS host caching"
  100.  
  101. private const L_optClearKmsHostCaching = "ckhc"
  102. private const L_optClearKmsHostCachingUsage = "Disable KMS host caching"
  103.  
  104. private const L_optSetActivationInterval = "sai"
  105. 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."
  106.  
  107. private const L_optSetRenewalInterval = "sri"
  108. 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."
  109.  
  110. private const L_optSetKmsListenPort = "sprt"
  111. private const L_optSetKmsListenPortUsage = "Set TCP port KMS will use to communicate with clients"
  112.  
  113. private const L_optSetDNS = "sdns"
  114. private const L_optSetDNSUsage = "Enable DNS publishing by KMS (default)"
  115.  
  116. private const L_optClearDNS = "cdns"
  117. private const L_optClearDNSUsage = "Disable DNS publishing by KMS"
  118.  
  119. private const L_optSetNormalPriority = "spri"
  120. private const L_optSetNormalPriorityUsage = "Set KMS priority to normal (default)"
  121.  
  122. private const L_optClearNormalPriority = "cpri"
  123. private const L_optClearNormalPriorityUsage = "Set KMS priority to low"
  124.  
  125. private const L_optSetVLActivationType = "act-type"
  126. private const L_optSetVLActivationTypeUsage = "Set activation type to 1 (for AD) or 2 (for KMS) or 3 (for Token) or 0 (for all)."
  127.  
  128. ' Token-based Activation options
  129.  
  130. private const L_optListInstalledILs = "lil"
  131. private const L_optListInstalledILsUsage = "List installed Token-based Activation Issuance Licenses"
  132.  
  133. private const L_optRemoveInstalledIL = "ril"
  134. private const L_optRemoveInstalledILUsage = "Remove installed Token-based Activation Issuance License"
  135.  
  136. private const L_optListTkaCerts = "ltc"
  137. private const L_optListTkaCertsUsage = "List Token-based Activation Certificates"
  138.  
  139. private const L_optForceTkaActivation = "fta"
  140. private const L_optForceTkaActivationUsage = "Force Token-based Activation"
  141.  
  142. ' Active Directory Activation options
  143.  
  144. private const L_optADActivate = "ad-activation-online"
  145. private const L_optADActivateUsage = "Activate AD (Active Directory) forest with user-provided product key"
  146.  
  147. private const L_optADGetIID = "ad-activation-get-iid"
  148. private const L_optADGetIIDUsage = "Display Installation ID for AD (Active Directory) forest"
  149.  
  150. private const L_optADApplyCID = "ad-activation-apply-cid"
  151. private const L_optADApplyCIDUsage = "Activate AD (Active Directory) forest with user-provided product key and Confirmation ID"
  152.  
  153. private const L_optADListAOs = "ao-list"
  154. private const L_optADListAOsUsage = "Display Activation Objects in AD (Active Directory)"
  155.  
  156. private const L_optADDeleteAO = "del-ao"
  157. private const L_optADDeleteAOsUsage = "Delete Activation Objects in AD (Active Directory) for user-provided Activation Object"
  158.  
  159. ' Option parameters
  160. private const L_ParamsActivationID = "<Activation ID>"
  161. private const L_ParamsActivationIDOptional = "[Activation ID]"
  162. private const L_ParamsActIDOptional = "[Activation ID | All]"
  163. private const L_ParamsApplicationID = "<Application ID>"
  164. private const L_ParamsProductKey = "<Product Key>"
  165. private const L_ParamsLicenseFile = "<License file>"
  166. private const L_ParamsPhoneActivate = "<Confirmation ID>"
  167. private const L_ParamsSetKms = "<Name[:Port] | : port>"
  168. private const L_ParamsSetKmsLookupDomain = "<FQDN>"
  169. private const L_ParamsSetListenKmsPort = "<Port>"
  170. private const L_ParamsSetActivationInterval = "<Activation Interval>"
  171. private const L_ParamsSetRenewalInterval = "<Renewal Interval>"
  172. private const L_ParamsVLActivationTypeOptional = "[Activation-Type]"
  173.  
  174. private const L_ParamsRemoveInstalledIL = "<ILID> <ILvID>"
  175. private const L_ParamsForceTkaActivation = "<Certificate Thumbprint> [<PIN>]"
  176.  
  177. private const L_ParamsAONameOptional = "[Activation Object name]"
  178. private const L_ParamsAODistinguishedName = "<Activation Object DN | Activation Object RDN>"
  179.  
  180. ' Miscellaneous messages
  181. private const L_MsgHelp_1 = "Windows Software Licensing Management Tool"
  182. private const L_MsgHelp_2 = "Usage: slmgr.vbs [MachineName [User Password]] [<Option>]"
  183. private const L_MsgHelp_3 = "MachineName: Name of remote machine (default is local machine)"
  184. private const L_MsgHelp_4 = "User: Account with required privilege on remote machine"
  185. private const L_MsgHelp_5 = "Password: password for the previous account"
  186. private const L_MsgGlobalOptions = "Global Options:"
  187. private const L_MsgAdvancedOptions = "Advanced Options:"
  188. private const L_MsgKmsClientOptions = "Volume Licensing: Key Management Service (KMS) Client Options:"
  189. private const L_MsgKmsOptions = "Volume Licensing: Key Management Service (KMS) Options:"
  190. private const L_MsgADOptions = "Volume Licensing: Active Directory (AD) Activation Options:"
  191. private const L_MsgTkaClientOptions = "Volume Licensing: Token-based Activation Options:"
  192. private const L_MsgInvalidOptions = "Invalid combination of command parameters."
  193. private const L_MsgUnrecognizedOption = "Unrecognized option: "
  194. private const L_MsgErrorProductNotFound = "Error: product not found."
  195. private const L_MsgClearedPKey = "Product key from registry cleared successfully."
  196. private const L_MsgInstalledPKey = "Installed product key %PKEY% successfully."
  197. private const L_MsgUninstalledPKey = "Uninstalled product key successfully."
  198. private const L_MsgErrorPKey = "Error: product key not found."
  199. private const L_MsgInstallationID = "Installation ID: "
  200. 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\sppui\phone.inf"
  201. private const L_MsgActivating = "Activating %PRODUCTNAME% (%PRODUCTID%) ..."
  202. private const L_MsgActivated = "Product activated successfully."
  203. private const L_MsgActivated_Failed = "Error: Product activation failed."
  204. private const L_MsgConfID = "Confirmation ID for product %ACTID% deposited successfully."
  205. private const L_MsgErrorLocalWMI = "Error 0x%ERRCODE% occurred in connecting to the local WMI provider."
  206. private const L_MsgErrorLocalRegistry = "Error 0x%ERRCODE% occurred in connecting to the local registry."
  207. private const L_MsgErrorConnection = "Error 0x%ERRCODE% occurred in connecting to server %COMPUTERNAME%."
  208. private const L_MsgInfoRemoteConnection = "Connected to server %COMPUTERNAME%."
  209. private const L_MsgErrorConnectionRegistry = "Error 0x%ERRCODE% occurred in connecting to the registry on server %COMPUTERNAME%."
  210. private const L_MsgErrorImpersonation = "Error 0x%ERRCODE% occurred in setting impersonation level."
  211. private const L_MsgErrorAuthenticationLevel = "Error 0x%ERRCODE% occurred in setting authentication level."
  212. private const L_MsgErrorWMI = "Error 0x%ERRCODE% occurred in creating a locator object."
  213. private const L_MsgErrorText_6 = "On a computer running Microsoft Windows non-core edition, run 'slui.exe 0x2a 0x%ERRCODE%' to display the error text."
  214. private const L_MsgErrorText_8 = "Error: "
  215. private const L_MsgErrorText_9 = "Error: option %OPTION% needs %PARAM%"
  216. private const L_MsgErrorText_11 = "The machine is running within the non-genuine grace period. Run 'slui.exe' to go online and make the machine genuine."
  217. private const L_MsgErrorText_12 = "Windows is running within the non-genuine notification period. Run 'slui.exe' to go online and validate Windows."
  218. private const L_MsgLicenseFile = "License file %LICENSEFILE% installed successfully."
  219. private const L_MsgKmsPriSetToLow = "KMS priority set to Low"
  220. private const L_MsgKmsPriSetToNormal = "KMS priority set to Normal"
  221. private const L_MsgWarningKmsPri = "Warning: Priority can only be set on a KMS machine that is also activated."
  222. private const L_MsgKmsDnsPublishingDisabled = "DNS publishing disabled"
  223. private const L_MsgKmsDnsPublishingEnabled = "DNS publishing enabled"
  224. private const L_MsgKmsDnsPublishingWarning = "Warning: DNS Publishing can only be set on a KMS machine that is also activated."
  225. private const L_MsgKmsPortSet = "KMS port set to %PORT% successfully."
  226. private const L_MsgWarningKmsReboot = "Warning: a KMS reboot is needed for this setting to take effect."
  227. private const L_MsgWarningKmsPort = "Warning: KMS port can only be set on a KMS machine that is also activated."
  228. private const L_MsgRenewalSet = "Volume renewal interval set to %RENEWAL% minutes successfully."
  229. private const L_MsgWarningRenewal = "Warning: Volume renewal interval can only be set on a KMS machine that is also activated."
  230. private const L_MsgActivationSet = "Volume activation interval set to %ACTIVATION% minutes successfully."
  231. private const L_MsgWarningActivation = "Warning: Volume activation interval can only be set on a KMS machine that is also activated."
  232. private const L_MsgKmsNameSet = "Key Management Service machine name set to %KMS% successfully."
  233. private const L_MsgKmsNameCleared = "Key Management Service machine name cleared successfully."
  234. private const L_MsgKmsLookupDomainSet = "Key Management Service lookup domain set to %FQDN% successfully."
  235. private const L_MsgKmsLookupDomainCleared = "Key Management Service lookup domain cleared successfully."
  236. private const L_MsgKmsUseMachineNameOverrides = "Warning: /skms setting overrides the /skms-domain setting. %KMS% will be used for activation."
  237. private const L_MsgKmsUseMachineName = "Warning: /skms setting is in effect. %KMS% will be used for activation."
  238. private const L_MsgKmsUseLookupDomain = "Warning: /skms-domain setting is in effect. %FQDN% will be used for DNS SRV record lookup."
  239. private const L_MsgKmsHostCachingDisabled = "KMS host caching is disabled"
  240. private const L_MsgKmsHostCachingEnabled = "KMS host caching is enabled"
  241. private const L_MsgErrorActivationID = "Error: Activation ID (%ActID%) not found."
  242. private const L_MsgVLActivationTypeSet = "Volume activation type set successfully."
  243. private const L_MsgRearm_1 = "Command completed successfully."
  244. private const L_MsgRearm_2 = "Please restart the system for the changes to take effect."
  245. private const L_MsgRemainingWindowsRearmCount = "Remaining Windows rearm count: %COUNT%"
  246. private const L_MsgRemainingSkuRearmCount = "Remaining SKU rearm count: %COUNT%"
  247. private const L_MsgRemainingAppRearmCount = "Remaining App rearm count: %COUNT%"
  248. ' Used for xpr
  249. private const L_MsgLicenseStatusUnlicensed = "Unlicensed"
  250. private const L_MsgLicenseStatusVL = "Volume activation will expire %ENDDATE%"
  251. private const L_MsgLicenseStatusTBL = "Timebased activation will expire %ENDDATE%"
  252. private const L_MsgLicenseStatusAVMA = "Automatic VM activation will expire %ENDDATE%"
  253. private const L_MsgLicenseStatusLicensed = "The machine is permanently activated."
  254. private const L_MsgLicenseStatusInitialGrace = "Initial grace period ends %ENDDATE%"
  255. private const L_MsgLicenseStatusAdditionalGrace = "Additional grace period ends %ENDDATE%"
  256. private const L_MsgLicenseStatusNonGenuineGrace = "Non-genuine grace period ends %ENDDATE%"
  257. private const L_MsgLicenseStatusNotification = "Windows is in Notification mode"
  258. private const L_MsgLicenseStatusExtendedGrace = "Extended grace period ends %ENDDATE%"
  259.  
  260. ' Used for dli/dlv
  261. private const L_MsgLicenseStatusUnlicensed_1 = "License Status: Unlicensed"
  262. private const L_MsgLicenseStatusLicensed_1 = "License Status: Licensed"
  263. private const L_MsgLicenseStatusVL_1 = "Volume activation expiration: %MINUTE% minute(s) (%DAY% day(s))"
  264. private const L_MsgLicenseStatusTBL_1 = "Timebased activation expiration: %MINUTE% minute(s) (%DAY% day(s))"
  265. private const L_MsgLicenseStatusAVMA_1 = "Automatic VM activation expiration: %MINUTE% minute(s) (%DAY% day(s))"
  266. private const L_MsgLicenseStatusInitialGrace_1 = "License Status: Initial grace period"
  267. private const L_MsgLicenseStatusAdditionalGrace_1 = "License Status: Additional grace period (KMS license expired or hardware out of tolerance)"
  268. private const L_MsgLicenseStatusNonGenuineGrace_1 = "License Status: Non-genuine grace period."
  269. private const L_MsgLicenseStatusNotification_1 = "License Status: Notification"
  270. private const L_MsgLicenseStatusExtendedGrace_1 = "License Status: Extended grace period"
  271.  
  272. private const L_MsgNotificationErrorReasonNonGenuine = "Notification Reason: 0x%ERRCODE% (non-genuine)."
  273. private const L_MsgNotificationErrorReasonExpiration = "Notification Reason: 0x%ERRCODE% (grace time expired)."
  274. private const L_MsgNotificationErrorReasonOther = "Notification Reason: 0x%ERRCODE%."
  275. private const L_MsgLicenseStatusTimeRemaining = "Time remaining: %MINUTE% minute(s) (%DAY% day(s))"
  276. private const L_MsgLicenseStatusUnknown = "License Status: Unknown"
  277. private const L_MsgLicenseStatusEvalEndData = "Evaluation End Date: "
  278. private const L_MsgReinstallingLicenses = "Re-installing license files ..."
  279. private const L_MsgLicensesReinstalled = "License files re-installed successfully."
  280. private const L_MsgServiceVersion = "Software licensing service version: "
  281. private const L_MsgProductName = "Name: "
  282. private const L_MsgProductDesc = "Description: "
  283. private const L_MsgActID = "Activation ID: "
  284. private const L_MsgAppID = "Application ID: "
  285. private const L_MsgPID4 = "Extended PID: "
  286. private const L_MsgChannel = "Product Key Channel: "
  287. private const L_MsgProcessorCertUrl = "Processor Certificate URL: "
  288. private const L_MsgMachineCertUrl = "Machine Certificate URL: "
  289. private const L_MsgUseLicenseCertUrl = "Use License URL: "
  290. private const L_MsgPKeyCertUrl = "Product Key Certificate URL: "
  291. private const L_MsgValidationUrl = "Validation URL: "
  292. private const L_MsgPartialPKey = "Partial Product Key: "
  293. private const L_MsgErrorLicenseNotInUse = "This license is not in use."
  294. private const L_MsgKmsInfo = "Key Management Service client information"
  295. private const L_MsgCmid = "Client Machine ID (CMID): "
  296. private const L_MsgRegisteredKmsName = "Registered KMS machine name: "
  297. private const L_MsgKmsLookupDomain = "Registered KMS SRV record lookup domain: "
  298. private const L_MsgKmsFromDnsUnavailable = "DNS auto-discovery: KMS name not available"
  299. private const L_MsgKmsFromDns = "KMS machine name from DNS: "
  300. private const L_MsgKmsIpAddress = "KMS machine IP address: "
  301. private const L_MsgKmsIpAddressUnavailable = "KMS machine IP address: not available"
  302. private const L_MsgKmsPID4 = "KMS machine extended PID: "
  303. private const L_MsgActivationInterval = "Activation interval: %INTERVAL% minutes"
  304. private const L_MsgRenewalInterval = "Renewal interval: %INTERVAL% minutes"
  305. private const L_MsgKmsEnabled = "Key Management Service is enabled on this machine"
  306. private const L_MsgKmsCurrentCount = "Current count: "
  307. private const L_MsgKmsListeningOnPort = "Listening on Port: "
  308. private const L_MsgKmsPriNormal = "KMS priority: Normal"
  309. private const L_MsgKmsPriLow = "KMS priority: Low"
  310. private const L_MsgVLActivationTypeAll = "Configured Activation Type: All"
  311. private const L_MsgVLActivationTypeAD = "Configured Activation Type: AD"
  312. private const L_MsgVLActivationTypeKMS = "Configured Activation Type: KMS"
  313. private const L_MsgVLActivationTypeToken = "Configured Activation Type: Token"
  314. private const L_MsgVLMostRecentActivationInfo = "Most recent activation information:"
  315. private const L_MsgInvalidDataError = "Error: The data is invalid"
  316. private const L_MsgUndeterminedPrimaryKey = "Warning: SLMGR was not able to validate the current product key for Windows. Please upgrade to the latest service pack."
  317. private const L_MsgUndeterminedPrimaryKeyOperation = "Warning: This operation may affect more than one target license. Please verify the results."
  318. private const L_MsgUndeterminedOperationFormat = "Processing the license for %PRODUCTDESCRIPTION% (%PRODUCTID%)."
  319. private const L_MsgPleaseActivateRefreshKMSInfo = "Please use slmgr.vbs /ato to activate and update KMS client information in order to update values."
  320. private const L_MsgTokenBasedActivationMustBeDone = "This system is configured for Token-based activation only. Use slmgr.vbs /fta to initiate Token-based activation, or slmgr.vbs /act-type to change the activation type setting."
  321.  
  322. private const L_MsgKmsCumulativeRequestsFromClients = "Key Management Service cumulative requests received from clients"
  323. private const L_MsgKmsTotalRequestsRecieved = "Total requests received: "
  324. private const L_MsgKmsFailedRequestsReceived = "Failed requests received: "
  325. private const L_MsgKmsRequestsWithStatusUnlicensed = "Requests with License Status Unlicensed: "
  326. private const L_MsgKmsRequestsWithStatusLicensed = "Requests with License Status Licensed: "
  327. private const L_MsgKmsRequestsWithStatusInitialGrace = "Requests with License Status Initial grace period: "
  328. private const L_MsgKmsRequestsWithStatusLicenseExpiredOrHwidOot = "Requests with License Status License expired or Hardware out of tolerance: "
  329. private const L_MsgKmsRequestsWithStatusNonGenuineGrace = "Requests with License Status Non-genuine grace period: "
  330. private const L_MsgKmsRequestsWithStatusNotification = "Requests with License Status Notification: "
  331.  
  332. private const L_MsgRemoteWmiVersionMismatch = "The remote machine does not support this version of SLMgr.vbs"
  333.  
  334. private const L_MsgRemoteExecNotSupported = "This command of SLMgr.vbs is not supported for remote execution"
  335.  
  336. '
  337. ' Token-based Activation issuance licenses
  338. '
  339. private const L_MsgTkaLicenses = "Token-based Activation Issuance Licenses:"
  340. private const L_MsgTkaLicenseHeader = "%ILID% %ILVID%"
  341. private const L_MsgTkaLicenseILID = "License ID (ILID): %ILID%"
  342. private const L_MsgTkaLicenseILVID = "Version ID (ILvID): %ILVID%"
  343. private const L_MsgTkaLicenseExpiration = "Valid to: %TODATE%"
  344. private const L_MsgTkaLicenseAdditionalInfo = "Additional Information: %MOREINFO%"
  345. private const L_MsgTkaLicenseAuthZStatus = "Error: 0x%ERRCODE%"
  346. private const L_MsgTkaLicenseDescr = "Description: %DESC%"
  347. private const L_MsgTkaLicenseNone = "No licenses found."
  348.  
  349. private const L_MsgTkaRemoving = "Removing Token-based Activation License ..."
  350. private const L_MsgTkaRemovedItem = "Removed license with SLID=%SLID%."
  351. private const L_MsgTkaRemovedNone = "No licenses found."
  352.  
  353. private const L_MsgTkaInfoAdditionalInfo = "Additional Information: %MOREINFO%"
  354. private const L_MsgTkaInfo = "Token-based Activation information"
  355. private const L_MsgTkaInfoILID = "License ID (ILID): %ILID%"
  356. private const L_MsgTkaInfoILVID = "Version ID (ILvID): %ILVID%"
  357. private const L_MsgTkaInfoGrantNo = "Grant Number: %GRANTNO%"
  358. private const L_MsgTkaInfoThumbprint = "Certificate Thumbprint: %THUMBPRINT%"
  359.  
  360. private const L_MsgTkaCertThumbprint = "Thumbprint: %THUMBPRINT%"
  361. private const L_MsgTkaCertSubject = "Subject: %SUBJECT%"
  362. private const L_MsgTkaCertIssuer = "Issuer: %ISSUER%"
  363. private const L_MsgTkaCertValidFrom = "Valid from: %FROMDATE%"
  364. private const L_MsgTkaCertValidTo = "Valid to: %TODATE%"
  365.  
  366. '
  367. ' AD Activation messages
  368. '
  369. private const L_MsgADInfo = "AD Activation client information"
  370. private const L_MsgADInfoAOName = "Activation Object name: "
  371. private const L_MsgADInfoAODN = "AO DN: "
  372. private const L_MsgADInfoExtendedPid = "AO extended PID: "
  373. private const L_MsgADInfoActID = "AO activation ID: "
  374. private const L_MsgActObjAvailable = "Activation Objects"
  375. private const L_MsgActObjNoneFound = "No objects found"
  376. private const L_MsgSucess = "Operation completed successfully."
  377. private const L_MsgADSchemaNotSupported = "Active Directory-Based Activation is not supported in the current Active Directory schema."
  378.  
  379. '
  380. ' Automatic VM Activation messages
  381. '
  382. private const L_MsgAVMAInfo = "Automatic VM Activation client information"
  383. private const L_MsgAVMAID = "Guest IAID: "
  384. private const L_MsgAVMAHostMachineName = "Host machine name: "
  385. private const L_MsgAVMALastActTime = "Activation time: "
  386. private const L_MsgAVMAHostPid2 = "Host Digital PID2: "
  387. private const L_MsgNotAvailable = "Not Available"
  388.  
  389. private const L_MsgCurrentTrustedTime = "Trusted time: "
  390.  
  391. private const NoPrimaryKeyFound = "NoPrimaryKeyFound"
  392. private const TblPrimaryKey = "TblPrimaryKey"
  393. private const NotSpecialCasePrimaryKey = "NotSpecialCasePrimaryKey"
  394. private const IndeterminatePrimaryKeyFound = "IndeterminatePrimaryKey"
  395.  
  396. private const L_MsgError_C004C001 = "The activation server determined the specified product key is invalid"
  397. private const L_MsgError_C004C003 = "The activation server determined the specified product key is blocked"
  398. private const L_MsgError_C004C017 = "The activation server determined the specified product key has been blocked for this geographic location."
  399. private const L_MsgError_C004B100 = "The activation server determined that the computer could not be activated"
  400. private const L_MsgError_C004C008 = "The activation server determined that the specified product key could not be used"
  401. private const L_MsgError_C004C020 = "The activation server reported that the Multiple Activation Key has exceeded its limit"
  402. private const L_MsgError_C004C021 = "The activation server reported that the Multiple Activation Key extension limit has been exceeded"
  403. private const L_MsgError_C004D307 = "The maximum allowed number of re-arms has been exceeded. You must re-install the OS before trying to re-arm again"
  404. private const L_MsgError_C004F009 = "The software Licensing Service reported that the grace period expired"
  405. private const L_MsgError_C004F00F = "The Software Licensing Server reported that the hardware ID binding is beyond level of tolerance"
  406. private const L_MsgError_C004F014 = "The Software Licensing Service reported that the product key is not available"
  407. private const L_MsgError_C004F025 = "Access denied: the requested action requires elevated privileges"
  408. private const L_MsgError_C004F02C = "The software Licensing Service reported that the format for the offline activation data is incorrect"
  409. private const L_MsgError_C004F035 = "The software Licensing Service reported that the computer could not be activated with a Volume license product key. Volume licensed systems require upgrading from a qualified operating system. Please contact your system administrator or use a different type of key"
  410. private const L_MsgError_C004F038 = "The software Licensing Service reported that the computer could not be activated. The count reported by your Key Management Service (KMS) is insufficient. Please contact your system administrator"
  411. private const L_MsgError_C004F039 = "The software Licensing Service reported that the computer could not be activated. The Key Management Service (KMS) is not enabled"
  412. private const L_MsgError_C004F041 = "The software Licensing Service determined that the Key Management Server (KMS) is not activated. KMS needs to be activated"
  413. private const L_MsgError_C004F042 = "The software Licensing Service determined that the specified Key Management Service (KMS) cannot be used"
  414. private const L_MsgError_C004F050 = "The Software Licensing Service reported that the product key is invalid"
  415. private const L_MsgError_C004F051 = "The software Licensing Service reported that the product key is blocked"
  416. private const L_MsgError_C004F064 = "The software Licensing Service reported that the non-Genuine grace period expired"
  417. private const L_MsgError_C004F065 = "The software Licensing Service reported that the application is running within the valid non-genuine period"
  418. private const L_MsgError_C004F066 = "The Software Licensing Service reported that the product SKU is not found"
  419. private const L_MsgError_C004F06B = "The software Licensing Service determined that it is running in a virtual machine. The Key Management Service (KMS) is not supported in this mode"
  420. private const L_MsgError_C004F074 = "The Software Licensing Service reported that the computer could not be activated. No Key Management Service (KMS) could be contacted. Please see the Application Event Log for additional information."
  421. private const L_MsgError_C004F075 = "The Software Licensing Service reported that the operation cannot be completed because the service is stopping"
  422.  
  423. private const L_MsgError_C004F304 = "The Software Licensing Service reported that required license could not be found."
  424. private const L_MsgError_C004F305 = "The Software Licensing Service reported that there are no certificates found in the system that could activate the product."
  425. private const L_MsgError_C004F30A = "The Software Licensing Service reported that the computer could not be activated. The certificate does not match the conditions in the license."
  426. private const L_MsgError_C004F30D = "The Software Licensing Service reported that the computer could not be activated. The thumbprint is invalid."
  427. private const L_MsgError_C004F30E = "The Software Licensing Service reported that the computer could not be activated. A certificate for the thumbprint could not be found."
  428.  
  429. private const L_MsgError_C004F30F = "The Software Licensing Service reported that the computer could not be activated. The certificate does not match the criteria specified in the issuance license."
  430. private const L_MsgError_C004F310 = "The Software Licensing Service reported that the computer could not be activated. The certificate does not match the trust point identifier (TPID) specified in the issuance license."
  431. private const L_MsgError_C004F311 = "The Software Licensing Service reported that the computer could not be activated. A soft token cannot be used for activation."
  432. private const L_MsgError_C004F312 = "The Software Licensing Service reported that the computer could not be activated. The certificate cannot be used because its private key is exportable."
  433.  
  434. private const L_MsgError_5 = "Access denied: the requested action requires elevated privileges"
  435. private const L_MsgError_80070005 = "Access denied: the requested action requires elevated privileges"
  436. private const L_MsgError_80070057 = "The parameter is incorrect"
  437. private const L_MsgError_8007232A = "DNS server failure"
  438. private const L_MsgError_8007232B = "DNS name does not exist"
  439. private const L_MsgError_800706BA = "The RPC server is unavailable"
  440. private const L_MsgError_8007251D = "No records found for DNS query"
  441.  
  442. ' Registry constants
  443. private const HKEY_LOCAL_MACHINE = &H80000002
  444. private const HKEY_NETWORK_SERVICE = &H80000003
  445.  
  446. private const DefaultPort = "1688"
  447. private const intKnownOption = 0
  448. private const intUnknownOption = 1
  449.  
  450. private const SLKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\SoftwareProtectionPlatform"
  451. private const SLKeyPath32 = "SOFTWARE\Wow6432Node\Microsoft\Windows NT\CurrentVersion\SoftwareProtectionPlatform"
  452. private const NSKeyPath = "S-1-5-20\SOFTWARE\Microsoft\Windows NT\CurrentVersion\SoftwareProtectionPlatform"
  453.  
  454. private const HR_S_OK = 0
  455. private const HR_ERROR_FILE_NOT_FOUND = &H80070002
  456. private const HR_SL_E_GRACE_TIME_EXPIRED = &HC004F009
  457. private const HR_SL_E_NOT_GENUINE = &HC004F200
  458. private const HR_SL_E_PKEY_NOT_INSTALLED = &HC004F014
  459. private const HR_INVALID_ARG = &H80070057
  460. private const HR_ERROR_DS_NO_SUCH_OBJECT = &H80072030
  461.  
  462. ' AD Activation constants
  463. private const ADLdapProvider = "LDAP:"
  464. private const ADLdapProviderPrefix = "LDAP://"
  465. private const ADRootDSE = "rootDSE"
  466. private const ADConfigurationNC = "configurationNamingContext"
  467. private const ADActObjContainer = "CN=Activation Objects,CN=Microsoft SPP,CN=Services,"
  468. private const ADActObjContainerClass = "msSPP-ActivationObjectsContainer"
  469. private const ADActObjClass = "msSPP-ActivationObject"
  470. private const ADActObjAttribSkuId = "msSPP-CSVLKSkuId"
  471. private const ADActObjAttribPid = "msSPP-CSVLKPid"
  472. private const ADActObjAttribPartialPkey = "msSPP-CSVLKPartialProductKey"
  473. private const ADActObjDisplayName = "displayName"
  474. private const ADActObjAttribDN = "distinguishedName"
  475.  
  476. private const ADS_READONLY_SERVER = 4
  477.  
  478. ' WMI class names
  479. private const ServiceClass = "SoftwareLicensingService"
  480. private const ProductClass = "SoftwareLicensingProduct"
  481. private const TkaLicenseClass = "SoftwareLicensingTokenActivationLicense"
  482. private const WindowsAppId = "55c92734-d682-4d71-983e-d6ec3f16059f"
  483.  
  484. private const ProductIsPrimarySkuSelectClause = "ID, ApplicationId, PartialProductKey, LicenseIsAddon, Description, Name"
  485. private const KMSClientLookupClause = "KeyManagementServiceMachine, KeyManagementServicePort, KeyManagementServiceLookupDomain"
  486.  
  487. private const PartialProductKeyNonNullWhereClause = "PartialProductKey <> null"
  488. private const EmptyWhereClause = ""
  489.  
  490. private const wbemImpersonationLevelImpersonate = 3
  491. private const wbemAuthenticationLevelPktPrivacy = 6
  492.  
  493. 'Call ShowErrorTest
  494.  
  495. Call ExecCommandLine()
  496. ExitScript 0
  497.  
  498. Private Sub DisplayUsage ()
  499.  
  500. LineOut GetResource("L_MsgHelp_1")
  501. LineOut GetResource("L_MsgHelp_2")
  502. LineOut " " & GetResource("L_MsgHelp_3")
  503. LineOut " " & GetResource("L_MsgHelp_4")
  504. LineOut " " & GetResource("L_MsgHelp_5")
  505. LineOut ""
  506. LineOut GetResource("L_MsgGlobalOptions")
  507. OptLine GetResource("L_optInstallProductKey"), GetResource("L_ParamsProductKey"), GetResource("L_optInstallProductKeyUsage")
  508. OptLine GetResource("L_optActivateProduct"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optActivateProductUsage")
  509. OptLine GetResource("L_optDisplayInformation"), GetResource("L_ParamsActIDOptional"), GetResource("L_optDisplayInformationUsage")
  510. OptLine GetResource("L_optDisplayInformationVerbose"), GetResource("L_ParamsActIDOptional"), GetResource("L_optDisplayInformationUsageVerbose")
  511. OptLine GetResource("L_optExpirationDatime"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optExpirationDatimeUsage")
  512.  
  513. LineFlush ""
  514.  
  515. LineOut GetResource("L_MsgAdvancedOptions")
  516. OptLine GetResource("L_optClearPKeyFromRegistry"), "", GetResource("L_optClearPKeyFromRegistryUsage")
  517. OptLine GetResource("L_optInstallLicense"), GetResource("L_ParamsLicenseFile"), GetResource("L_optInstallLicenseUsage")
  518. OptLine GetResource("L_optReinstallLicenses"), "", GetResource("L_optReinstallLicensesUsage")
  519. OptLine GetResource("L_optReArmWindows"), "", GetResource("L_optReArmWindowsUsage")
  520. OptLine GetResource("L_optReArmApplication"), GetResource("L_ParamsApplicationID"), GetResource("L_optReArmApplicationUsage")
  521. OptLine GetResource("L_optReArmSku"), GetResource("L_ParamsActivationID"), GetResource("L_optReArmSkuUsage")
  522. OptLine GetResource("L_optUninstallProductKey"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optUninstallProductKeyUsage")
  523.  
  524.  
  525. LineOut ""
  526. OptLine GetResource("L_optDisplayIID"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optDisplayIIDUsage")
  527. OptLine2 GetResource("L_optPhoneActivateProduct"), GetResource("L_ParamsPhoneActivate"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optPhoneActivateProductUsage")
  528.  
  529. LineOut ""
  530. LineOut GetResource("L_MsgKmsClientOptions")
  531. OptLine2 GetResource("L_optSetKmsName"), GetResource("L_ParamsSetKms"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optSetKmsNameUsage")
  532. OptLine GetResource("L_optClearKmsName"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optClearKmsNameUsage")
  533. OptLine2 GetResource("L_optSetKmsLookupDomain"), GetResource("L_ParamsSetKmsLookupDomain"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optSetKmsLookupDomainUsage")
  534. OptLine GetResource("L_optClearKmsLookupDomain"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optClearKmsLookupDomainUsage")
  535. OptLine GetResource("L_optSetKmsHostCaching"), "", GetResource("L_optSetKmsHostCachingUsage")
  536. OptLine GetResource("L_optClearKmsHostCaching"), "", GetResource("L_optClearKmsHostCachingUsage")
  537.  
  538. LineFlush ""
  539.  
  540. LineOut GetResource("L_MsgTkaClientOptions")
  541. OptLine GetResource("L_optListInstalledILs"), "", GetResource("L_optListInstalledILsUsage")
  542. OptLine GetResource("L_optRemoveInstalledIL"), GetResource("L_ParamsRemoveInstalledIL"), GetResource("L_optRemoveInstalledILUsage")
  543. OptLine GetResource("L_optListTkaCerts"), "", GetResource("L_optListTkaCertsUsage")
  544. OptLine GetResource("L_optForceTkaActivation"), GetResource("L_ParamsForceTkaActivation"), GetResource("L_optForceTkaActivationUsage")
  545.  
  546. LineFlush ""
  547.  
  548. LineOut GetResource("L_MsgKmsOptions")
  549. OptLine GetResource("L_optSetKmsListenPort"), GetResource("L_ParamsSetListenKmsPort"), GetResource("L_optSetKmsListenPortUsage")
  550. OptLine GetResource("L_optSetActivationInterval"), GetResource("L_ParamsSetActivationInterval"), GetResource("L_optSetActivationIntervalUsage")
  551. OptLine GetResource("L_optSetRenewalInterval"), GetResource("L_ParamsSetRenewalInterval"), GetResource("L_optSetRenewalIntervalUsage")
  552. OptLine GetResource("L_optSetDNS"), "", GetResource("L_optSetDNSUsage")
  553. OptLine GetResource("L_optClearDNS"), "", GetResource("L_optClearDNSUsage")
  554. OptLine GetResource("L_optSetNormalPriority"), "", GetResource("L_optSetNormalPriorityUsage")
  555. OptLine GetResource("L_optClearNormalPriority"), "", GetResource("L_optClearNormalPriorityUsage")
  556. OptLine2 GetResource("L_optSetVLActivationType"), GetResource("L_ParamsVLActivationTypeOptional"), GetResource("L_ParamsActivationIDOptional"), GetResource("L_optSetVLActivationTypeUsage")
  557.  
  558. LineFlush ""
  559.  
  560. LineOut GetResource("L_MsgADOptions")
  561. OptLine2 GetResource("L_optADActivate"), GetResource("L_ParamsProductKey"), GetResource("L_ParamsAONameOptional"), GetResource("L_optADActivateUsage")
  562. OptLine GetResource("L_optADGetIID"), GetResource("L_ParamsProductKey"), GetResource("L_optADGetIIDUsage")
  563. OptLine3 GetResource("L_optADApplyCID"), GetResource("L_ParamsProductKey"), GetResource("L_ParamsPhoneActivate"), GetResource("L_ParamsAONameOptional"), GetResource("L_optADApplyCIDUsage")
  564. OptLine GetResource("L_optADListAOs"), "", GetResource("L_optADListAOsUsage")
  565. OptLine GetResource("L_optADDeleteAO"), GetResource("L_ParamsAODistinguishedName"), GetResource("L_optADDeleteAOsUsage")
  566.  
  567. ExitScript 1
  568. End Sub
  569.  
  570. Private Sub OptLine(strOption, strParams, strUsage)
  571. LineOut "/" & strOption & " " & strParams
  572. LineOut " " & strUsage
  573. End Sub
  574.  
  575. Private Sub OptLine2(strOption, strParam1, strParam2, strUsage)
  576. LineOut "/" & strOption & " " & strParam1 & " " & strParam2
  577. LineOut " " & strUsage
  578. End Sub
  579.  
  580. Private Sub OptLine3(strOption, strParam1, strParam2, strParam3, strUsage)
  581. LineOut "/" & strOption & " " & strParam1 & " " & strParam2 & " " & strParam3
  582. LineOut " " & strUsage
  583. End Sub
  584.  
  585. Private Sub ExecCommandLine
  586. Dim intOption, indexOption
  587. Dim strOption, chOpt
  588. Dim remoteInfo(3)
  589.  
  590. '
  591. ' First three parameters before "/" or "-" may be remote connection info
  592. '
  593.  
  594. remoteInfo(0) = "."
  595. intOption = intUnknownOption
  596.  
  597. For indexOption = 0 To 3
  598. If indexOption >= WScript.Arguments.Count Then
  599. Exit For
  600. End If
  601.  
  602. strOption = WScript.Arguments.Item(indexOption)
  603.  
  604. chOpt = Left(strOption, 1)
  605. If chOpt = "/" Or chOpt = "-" Then
  606. intOption = intKnownOption
  607. Exit For
  608. End If
  609.  
  610. remoteInfo(indexOption) = strOption
  611. Next
  612.  
  613. '
  614. ' Connect to remote only if syntax is reasonably good
  615. '
  616.  
  617. If intUnknownOption = intOption Or 2 = indexOption Then
  618. g_strComputer = "."
  619. intOption = intUnknownOption
  620. Else
  621. g_strComputer = remoteInfo(0)
  622. g_strUserName = remoteInfo(1)
  623. g_strPassword = remoteInfo(2)
  624. End If
  625.  
  626. Call Connect()
  627.  
  628. If intUnknownOption = intOption Then
  629. LineOut GetResource("L_MsgInvalidOptions")
  630. LineOut ""
  631. Call DisplayUsage()
  632. End If
  633.  
  634. intOption = ParseCommandLine(indexOption)
  635.  
  636. If intUnknownOption = intOption Then
  637. LineOut GetResource("L_MsgUnrecognizedOption") & WScript.Arguments.Item(indexOption)
  638. LineOut ""
  639. Call DisplayUsage()
  640. End If
  641. End Sub
  642.  
  643. Private Function ParseCommandLine(index)
  644. Dim strOption, chOpt
  645.  
  646. ParseCommandLine = intKnownOption
  647.  
  648. strOption = LCase(WScript.Arguments.Item(index))
  649.  
  650. chOpt = Left(strOption, 1)
  651.  
  652. If (chOpt <> "-") And (chOpt <> "/") Then
  653. ParseCommandLine = intUnknownOption
  654. Exit Function
  655. End If
  656.  
  657. strOption = Right(strOption, Len(strOption) - 1)
  658.  
  659. If strOption = GetResource("L_optInstallLicense") Then
  660.  
  661. If HandleOptionParam(index+1, True, GetResource("L_optInstallLicense"), GetResource("L_ParamsLicenseFile")) Then
  662. InstallLicense WScript.Arguments.Item(index+1)
  663. End If
  664.  
  665. ElseIf strOption = GetResource("L_optInstallProductKey") Then
  666.  
  667. If HandleOptionParam(index+1, True, GetResource("L_optInstallProductKey"), GetResource("L_ParamsProductKey")) Then
  668. InstallProductKey WScript.Arguments.Item(index+1)
  669. End If
  670.  
  671. ElseIf strOption = GetResource("L_optUninstallProductKey") Then
  672.  
  673. If HandleOptionParam(index+1, False, GetResource("L_optUninstallProductKey"), GetResource("L_ParamsActivationIDOptional")) Then
  674. UninstallProductKey WScript.Arguments.Item(index+1)
  675. Else
  676. UninstallProductKey ""
  677. End If
  678.  
  679. ElseIf strOption = GetResource("L_optDisplayIID") Then
  680.  
  681. If HandleOptionParam(index+1, False, GetResource("L_optDisplayIID"), GetResource("L_ParamsActivationIDOptional")) Then
  682. DisplayIID WScript.Arguments.Item(index+1)
  683. Else
  684. DisplayIID ""
  685. End If
  686.  
  687. ElseIf strOption = GetResource("L_optActivateProduct") Then
  688.  
  689. If HandleOptionParam(index+1, False, GetResource("L_optActivateProduct"), GetResource("L_ParamsActivationIDOptional")) Then
  690. ActivateProduct WScript.Arguments.Item(index+1)
  691. Else
  692. ActivateProduct ""
  693. End If
  694.  
  695. ElseIf strOption = GetResource("L_optPhoneActivateProduct") Then
  696.  
  697. If HandleOptionParam(index+1, True, GetResource("L_optPhoneActivateProduct"), GetResource("L_ParamsPhoneActivate")) Then
  698. If HandleOptionParam(index+2, False, GetResource("L_optPhoneActivateProduct"), GetResource("L_ParamsActivationIDOptional")) Then
  699. PhoneActivateProduct WScript.Arguments.Item(index+1), WScript.Arguments.Item(index+2)
  700. Else
  701. PhoneActivateProduct WScript.Arguments.Item(index+1), ""
  702. End If
  703. End If
  704.  
  705. ElseIf strOption = GetResource("L_optDisplayInformation") Then
  706.  
  707. If HandleOptionParam(index+1, False, GetResource("L_optDisplayInformation"), "") Then
  708. DisplayAllInformation WScript.Arguments.Item(index+1), False
  709. Else
  710. DisplayAllInformation "", False
  711. End If
  712.  
  713. ElseIf strOption = GetResource("L_optDisplayInformationVerbose") Then
  714.  
  715. If HandleOptionParam(index+1, False, GetResource("L_optDisplayInformationVerbose"), "") Then
  716. DisplayAllInformation WScript.Arguments.Item(index+1), True
  717. Else
  718. DisplayAllInformation "", True
  719. End If
  720.  
  721. ElseIf strOption = GetResource("L_optClearPKeyFromRegistry") Then
  722.  
  723. ClearPKeyFromRegistry
  724.  
  725. ElseIf strOption = GetResource("L_optReinstallLicenses") Then
  726.  
  727. ReinstallLicenses
  728.  
  729. ElseIf strOption = GetResource("L_optReArmWindows") Then
  730.  
  731. ReArmWindows()
  732.  
  733. ElseIf strOption = GetResource("L_optReArmApplication") Then
  734.  
  735. If HandleOptionParam(index+1, True, GetResource("L_optReArmApplication"), GetResource("L_ParamsApplicationID")) Then
  736. ReArmApp WScript.Arguments.Item(index+1)
  737. End If
  738.  
  739. ElseIf strOption = GetResource("L_optReArmSku") Then
  740.  
  741. If HandleOptionParam(index+1, True, GetResource("L_optReArmSku"), GetResource("L_ParamsActivationID")) Then
  742. ReArmSku WScript.Arguments.Item(index+1)
  743. End If
  744.  
  745. ElseIf strOption = GetResource("L_optExpirationDatime") Then
  746.  
  747. If HandleOptionParam(index+1, False, GetResource("L_optExpirationDatime"), GetResource("L_ParamsActivationIDOptional")) Then
  748. ExpirationDatime WScript.Arguments.Item(index+1)
  749. Else
  750. ExpirationDatime ""
  751. End If
  752.  
  753. ElseIf strOption = GetResource("L_optSetKmsName") Then
  754.  
  755. If HandleOptionParam(index+1, True, GetResource("L_optSetKmsName"), GetResource("L_ParamsSetKms")) Then
  756. If HandleOptionParam(index+2, False, GetResource("L_optSetKmsName"), GetResource("L_ParamsActivationIDOptional")) Then
  757. SetKmsMachineName WScript.Arguments.Item(index+1), WScript.Arguments.Item(index+2)
  758. Else
  759. SetKmsMachineName WScript.Arguments.Item(index+1), ""
  760. End If
  761. End If
  762.  
  763. ElseIf strOption = GetResource("L_optClearKmsName") Then
  764.  
  765. If HandleOptionParam(index+1, False, GetResource("L_optClearKmsName"), GetResource("L_ParamsActivationIDOptional")) Then
  766. ClearKms WScript.Arguments.Item(index+1)
  767. Else
  768. ClearKms ""
  769. End If
  770.  
  771. ElseIf strOption = GetResource("L_optSetKmsLookupDomain") Then
  772.  
  773. If HandleOptionParam(index+1, True, GetResource("L_optSetKmsLookupDomain"), GetResource("L_ParamsSetKmsLookupDomain")) Then
  774. If HandleOptionParam(index+2, False, GetResource("L_optSetKmsLookupDomain"), GetResource("L_ParamsActivationIDOptional")) Then
  775. SetKmsLookupDomain WScript.Arguments.Item(index+1), WScript.Arguments.Item(index+2)
  776. Else
  777. SetKmsLookupDomain WScript.Arguments.Item(index+1), ""
  778. End If
  779. End If
  780.  
  781. ElseIf strOption = GetResource("L_optClearKmsLookupDomain") Then
  782.  
  783. If HandleOptionParam(index+1, False, GetResource("L_optClearKmsLookupDomain"), GetResource("L_ParamsActivationIDOptional")) Then
  784. ClearKmsLookupDomain WScript.Arguments.Item(index+1)
  785. Else
  786. ClearKmsLookupDomain ""
  787. End If
  788.  
  789. ElseIf strOption = GetResource("L_optSetKmsHostCaching") Then
  790.  
  791. SetHostCachingDisable(False)
  792.  
  793. ElseIf strOption = GetResource("L_optClearKmsHostCaching") Then
  794.  
  795. SetHostCachingDisable(True)
  796.  
  797. ElseIf strOption = GetResource("L_optSetActivationInterval") Then
  798.  
  799. If HandleOptionParam(index+1, True, GetResource("L_optSetActivationInterval"), GetResource("L_ParamsSetActivationInterval")) Then
  800. SetActivationInterval WScript.Arguments.Item(index+1)
  801. End If
  802.  
  803. ElseIf strOption = GetResource("L_optSetRenewalInterval") Then
  804.  
  805. If HandleOptionParam(index+1, True, GetResource("L_optSetRenewalInterval"), GetResource("L_ParamsSetRenewalInterval")) Then
  806. SetRenewalInterval WScript.Arguments.Item(index+1)
  807. End If
  808.  
  809. ElseIf strOption = GetResource("L_optSetKmsListenPort") Then
  810.  
  811. If HandleOptionParam(index+1, True, GetResource("L_optSetKmsListenPort"), GetResource("L_ParamsSetListenKmsPort")) Then
  812. SetKmsListenPort WScript.Arguments.Item(index+1)
  813. End If
  814.  
  815. ElseIf strOption = GetResource("L_optSetDNS") Then
  816.  
  817. SetDnsPublishingDisabled(False)
  818.  
  819. ElseIf strOption = GetResource("L_optClearDNS") Then
  820.  
  821. SetDnsPublishingDisabled(True)
  822.  
  823. ElseIf strOption = GetResource("L_optSetNormalPriority") Then
  824.  
  825. SetKmsLowPriority(False)
  826.  
  827. ElseIf strOption = GetResource("L_optClearNormalPriority") Then
  828.  
  829. SetKmsLowPriority(True)
  830.  
  831. ElseIf strOption = GetResource("L_optSetVLActivationType") Then
  832.  
  833. If HandleOptionParam(index+1, False, GetResource("L_optSetVLActivationType"), GetResource("L_ParamsVLActivationTypeOptional")) Then
  834. If HandleOptionParam(index+2, False, GetResource("L_optSetVLActivationType"), GetResource("L_ParamsActivationIDOptional")) Then
  835. SetVLActivationType WScript.Arguments.Item(index+1), WScript.Arguments.Item(index+2)
  836. Else
  837. SetVLActivationType WScript.Arguments.Item(index+1), ""
  838. End If
  839. Else
  840. SetVLActivationType Null, ""
  841. End If
  842.  
  843. ElseIf strOption = GetResource("L_optListInstalledILs") Then
  844.  
  845. TkaListILs
  846.  
  847. ElseIf strOption = GetResource("L_optRemoveInstalledIL") Then
  848.  
  849. If HandleOptionParam(index+2, True, GetResource("L_optRemoveInstalledIL"), GetResource("L_ParamsRemoveInstalledIL")) Then
  850. TkaRemoveIL WScript.Arguments.Item(index+1), WScript.Arguments.Item(index+2)
  851. End If
  852.  
  853. ElseIf strOption = GetResource("L_optListTkaCerts") Then
  854.  
  855. TkaListCerts
  856.  
  857. ElseIf strOption = GetResource("L_optForceTkaActivation") Then
  858.  
  859. If HandleOptionParam(index+2, False, GetResource("L_optForceTkaActivation"), GetResource("L_ParamsForceTkaActivation")) Then
  860. TkaActivate WScript.Arguments.Item(index+1), WScript.Arguments.Item(index+2)
  861. ElseIf HandleOptionParam(index+1, True, GetResource("L_optForceTkaActivation"), GetResource("L_ParamsForceTkaActivation")) Then
  862. TkaActivate WScript.Arguments.Item(index+1), ""
  863. End If
  864.  
  865. ElseIf strOption = GetResource("L_optADGetIID") Then
  866.  
  867. If HandleOptionParam(index+1, True, GetResource("L_optADGetIID"), GetResource("L_ParamsProductKey")) Then
  868. ADGetIID WScript.Arguments.Item(index+1)
  869. End If
  870.  
  871. ElseIf strOption = GetResource("L_optADActivate") Then
  872.  
  873. If HandleOptionParam(index+1, True, GetResource("L_optADActivate"), GetResource("L_ParamsProductKey")) Then
  874. If HandleOptionParam(index+2, False, GetResource("L_optADActivate"), GetResource("L_ParamsAONameOptional")) Then
  875. ADActivateOnline WScript.Arguments.Item(index+1), WScript.Arguments.Item(index+2)
  876. Else
  877. ADActivateOnline WScript.Arguments.Item(index+1), ""
  878. End If
  879. End If
  880.  
  881. ElseIf strOption = GetResource("L_optADApplyCID") Then
  882.  
  883. If HandleOptionParam(index+1, True, GetResource("L_optADApplyCID"), GetResource("L_ParamsProductKey")) Then
  884. If HandleOptionParam(index+2, True, GetResource("L_optADApplyCID"), GetResource("L_ParamsPhoneActivate")) Then
  885. If HandleOptionParam(index+3, False, GetResource("L_optADApplyCID"), GetResource("L_ParamsAONameOptional")) Then
  886. ADActivatePhone WScript.Arguments.Item(index+1), WScript.Arguments.Item(index+2), WScript.Arguments.Item(index+3)
  887. Else
  888. ADActivatePhone WScript.Arguments.Item(index+1), WScript.Arguments.Item(index+2), ""
  889. End If
  890. End If
  891. End If
  892.  
  893. ElseIf strOption = GetResource("L_optADListAOs") Then
  894.  
  895. ADListActivationObjects
  896.  
  897. ElseIf strOption = GetResource("L_optADDeleteAO") Then
  898.  
  899. If HandleOptionParam(index+1, True, GetResource("L_optADDeleteAO"), GetResource("L_ParamsAODistinguishedName")) Then
  900. ADDeleteActivationObjects WScript.Arguments.Item(index+1)
  901. End If
  902.  
  903. Else
  904.  
  905. ParseCommandLine = intUnknownOption
  906.  
  907. End If
  908.  
  909. End Function
  910.  
  911. ' global options
  912.  
  913. Private Function CheckProductForCommand(objProduct, strActivationID)
  914. Dim bCheckProductForCommand
  915.  
  916. bCheckProductForCommand = False
  917.  
  918. If (strActivationID = "" And LCase(objProduct.ApplicationId) = WindowsAppId And (objProduct.LicenseIsAddon = False)) Then
  919. bCheckProductForCommand = True
  920. End If
  921.  
  922. If (LCase(objProduct.ID) = strActivationID) Then
  923. bCheckProductForCommand = True
  924. End If
  925.  
  926. CheckProductForCommand = bCheckProductForCommand
  927. End Function
  928.  
  929. Private Sub UninstallProductKey(strActivationID)
  930. Dim objService, objProduct
  931. Dim lRet, strVersion, strDescription
  932. Dim kmsServerFound, uninstallDone
  933. Dim iIsPrimaryWindowsSku, bPrimaryWindowsSkuKeyUninstalled
  934. Dim bCheckProductForCommand
  935.  
  936. On Error Resume Next
  937.  
  938. strActivationID = LCase(strActivationID)
  939. kmsServerFound = False
  940. uninstallDone = False
  941.  
  942. set objService = GetServiceObject("Version")
  943. strVersion = objService.Version
  944.  
  945. For Each objProduct in GetProductCollection(ProductIsPrimarySkuSelectClause & ", ProductKeyID", PartialProductKeyNonNullWhereClause)
  946. strDescription = objProduct.Description
  947.  
  948. bCheckProductForCommand = CheckProductForCommand(objProduct, strActivationID)
  949.  
  950. If (bCheckProductForCommand) Then
  951. iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct)
  952. If (strActivationID = "") And (iIsPrimaryWindowsSku = 2) Then
  953. OutputIndeterminateOperationWarning(objProduct)
  954. End If
  955.  
  956. objProduct.UninstallProductKey()
  957. QuitIfError()
  958.  
  959. ' Uninstalling a product key could change Windows licensing state.
  960. ' Since the service determines if it can shut down and when is the next start time
  961. ' based on the licensing state we should reconsume the licenses here.
  962. objService.RefreshLicenseStatus()
  963.  
  964. ' For Windows (i.e. if no activationID specified), always
  965. ' ensure that product-key for primary SKU is uninstalled
  966. If (strActivationID <> "") Or (iIsPrimaryWindowsSku = 1) Then
  967. uninstallDone = True
  968. End If
  969.  
  970. LineOut GetResource("L_MsgUninstalledPKey")
  971.  
  972. ' Check whether a ActID belongs to KMS server.
  973. ' Do this for all ActID other than one whose pkey is being uninstalled
  974. ElseIf IsKmsServer(strDescription) Then
  975. kmsServerFound = True
  976. End If
  977.  
  978. If (kmsServerFound = True) And (uninstallDone = True) Then
  979. Exit For
  980. End If
  981. Next
  982.  
  983. If kmsServerFound = True Then
  984. ' Set the KMS version in the registry (both 64 and 32 bit locations)
  985. lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceVersion", strVersion)
  986. If (lRet <> 0) Then
  987. QuitWithError lRet
  988. End If
  989.  
  990. lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath32, "KeyManagementServiceVersion", strVersion)
  991. If (lRet <> 0) Then
  992. QuitWithError lRet
  993. End If
  994. Else
  995. ' Clear the KMS version from the registry (both 64 and 32 bit locations)
  996. lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceVersion")
  997. If (lRet <> 0 And lRet <> 2) Then
  998. QuitWithError lRet
  999. End If
  1000.  
  1001. lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath32, "KeyManagementServiceVersion")
  1002. If (lRet <> 0 And lRet <> 2) Then
  1003. QuitWithError lRet
  1004. End If
  1005. End If
  1006.  
  1007. If uninstallDone = False Then
  1008. LineOut GetResource("L_MsgErrorPKey")
  1009. End If
  1010. End Sub
  1011.  
  1012. Private Sub DisplayIID(strActivationID)
  1013. Dim objProduct
  1014. Dim iIsPrimaryWindowsSku, bFoundAtLeastOneKey
  1015. Dim bCheckProductForCommand
  1016.  
  1017. strActivationID = LCase(strActivationID)
  1018.  
  1019. bFoundAtLeastOneKey = False
  1020. For Each objProduct in GetProductCollection(ProductIsPrimarySkuSelectClause & ", OfflineInstallationId", PartialProductKeyNonNullWhereClause)
  1021.  
  1022. bCheckProductForCommand = CheckProductForCommand(objProduct, strActivationID)
  1023.  
  1024. If (bCheckProductForCommand) Then
  1025. iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct)
  1026. If (strActivationID = "") And (iIsPrimaryWindowsSku = 2) Then
  1027. OutputIndeterminateOperationWarning(objProduct)
  1028. End If
  1029.  
  1030. LineOut GetResource("L_MsgInstallationID") & objProduct.OfflineInstallationId
  1031. bFoundAtLeastOneKey = True
  1032.  
  1033. If (strActivationID <> "") Or (iIsPrimaryWindowsSku = 1) Then
  1034. Exit Sub
  1035. End If
  1036. End If
  1037. Next
  1038.  
  1039. If (bFoundAtLeastOneKey = TRUE) Then
  1040. LineOut ""
  1041. LineOut GetResource("L_MsgPhoneNumbers")
  1042. Else
  1043. LineOut GetResource("L_MsgErrorProductNotFound")
  1044. End If
  1045. End Sub
  1046.  
  1047. Private Sub DisplayActivatingSku(objProduct)
  1048. Dim strOutput
  1049.  
  1050. strOutput = Replace(GetResource("L_MsgActivating"), "%PRODUCTNAME%", objProduct.Name)
  1051. strOutput = Replace(strOutput, "%PRODUCTID%", objProduct.ID)
  1052. LineFlush strOutput
  1053. End Sub
  1054.  
  1055. Private Sub DisplayActivatedStatus(objProduct)
  1056. If (objProduct.LicenseStatus = 1) Then
  1057. LineOut GetResource("L_MsgActivated")
  1058. ElseIf (objProduct.LicenseStatus = 4) Then
  1059. LineOut GetResource("L_MsgErrorText_8") & GetResource("L_MsgErrorText_11")
  1060. ElseIf ((objProduct.LicenseStatus = 5) And (objProduct.LicenseStatusReason = HR_SL_E_NOT_GENUINE)) Then
  1061. LineOut GetResource("L_MsgErrorText_8") & GetResource("L_MsgErrorText_12")
  1062. ElseIf (objProduct.LicenseStatus = 6) Then
  1063. LineOut GetResource("L_MsgActivated")
  1064. LineOut GetResource("L_MsgLicenseStatusExtendedGrace_1")
  1065. Else
  1066. LineOut GetResource("L_MsgActivated_Failed")
  1067. End If
  1068. End Sub
  1069.  
  1070. Private Sub ActivateProduct(strActivationID)
  1071. Dim objService, objProduct
  1072. Dim iIsPrimaryWindowsSku, bFoundAtLeastOneKey
  1073. Dim strOutput
  1074. Dim bCheckProductForCommand
  1075.  
  1076. strActivationID = LCase(strActivationID)
  1077.  
  1078. bFoundAtLeastOneKey = False
  1079.  
  1080. set objService = GetServiceObject("Version")
  1081.  
  1082. For Each objProduct in GetProductCollection(ProductIsPrimarySkuSelectClause & ", LicenseStatus, VLActivationTypeEnabled", PartialProductKeyNonNullWhereClause)
  1083.  
  1084. bCheckProductForCommand = CheckProductForCommand(objProduct, strActivationID)
  1085.  
  1086. If (bCheckProductForCommand) Then
  1087. iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct)
  1088. If (strActivationID = "") And (iIsPrimaryWindowsSku = 2) Then
  1089. OutputIndeterminateOperationWarning(objProduct)
  1090. End If
  1091.  
  1092. '
  1093. ' This routine does not perform token-based activation.
  1094. ' If configured for TA, then show message to user.
  1095. '
  1096. If (objProduct.VLActivationTypeEnabled = 3) Then
  1097. LineOut GetResource("L_MsgTokenBasedActivationMustBeDone")
  1098. Exit Sub
  1099. End If
  1100.  
  1101. strOutput = Replace(GetResource("L_MsgActivating"), "%PRODUCTNAME%", objProduct.Name)
  1102. strOutput = Replace(strOutput, "%PRODUCTID%", objProduct.ID)
  1103. LineOut strOutput
  1104. On Error Resume Next
  1105. '
  1106. ' Avoid using a MAK activation count up unless needed
  1107. '
  1108. If (Not(IsMAK(objProduct.Description)) Or (objProduct.LicenseStatus <> 1)) Then
  1109. objProduct.Activate()
  1110. QuitIfError()
  1111. objService.RefreshLicenseStatus()
  1112. objProduct.refresh_
  1113. End If
  1114. DisplayActivatedStatus objProduct
  1115.  
  1116. bFoundAtLeastOneKey = True
  1117. If (strActivationID <> "") Or (iIsPrimaryWindowsSku = 1) Then
  1118. Exit Sub
  1119. End If
  1120. End If
  1121. Next
  1122.  
  1123. If (bFoundAtLeastOneKey = True) Then
  1124. Exit Sub
  1125. End If
  1126.  
  1127. LineOut GetResource("L_MsgErrorProductNotFound")
  1128. End Sub
  1129.  
  1130. Private Sub PhoneActivateProduct(strCID, strActivationID)
  1131. Dim objService, objProduct
  1132. Dim iIsPrimaryWindowsSku, bFoundAtLeastOneKey
  1133. Dim strOutput
  1134. Dim bCheckProductForCommand
  1135.  
  1136. strActivationID = LCase(strActivationID)
  1137.  
  1138. bFoundAtLeastOneKey = False
  1139. set objService = GetServiceObject("Version")
  1140.  
  1141. For Each objProduct in GetProductCollection(ProductIsPrimarySkuSelectClause & ", OfflineInstallationId, LicenseStatus, LicenseStatusReason", PartialProductKeyNonNullWhereClause)
  1142.  
  1143. bCheckProductForCommand = CheckProductForCommand(objProduct, strActivationID)
  1144.  
  1145. If (bCheckProductForCommand) Then
  1146. iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct)
  1147. If (strActivationID = "") And (iIsPrimaryWindowsSku = 2) Then
  1148. OutputIndeterminateOperationWarning(objProduct)
  1149. End If
  1150.  
  1151. On Error Resume Next
  1152. objProduct.DepositOfflineConfirmationId objProduct.OfflineInstallationId, strCID
  1153. QuitIfError()
  1154. objService.RefreshLicenseStatus()
  1155. objProduct.refresh_
  1156. If (objProduct.LicenseStatus = 1) Then
  1157. strOutput = Replace(GetResource("L_MsgConfID"), "%ACTID%", objProduct.ID)
  1158. LineOut strOutput
  1159. ElseIf (objProduct.LicenseStatus = 4) Then
  1160. LineOut GetResource("L_MsgErrorText_8") & GetResource("L_MsgErrorText_11")
  1161. ElseIf ((objProduct.LicenseStatus = 5) And (objProduct.LicenseStatusReason = HR_SL_E_NOT_GENUINE)) Then
  1162. LineOut GetResource("L_MsgErrorText_8") & GetResource("L_MsgErrorText_12")
  1163. ElseIf (objProduct.LicenseStatus = 6) Then
  1164. LineOut GetResource("L_MsgActivated")
  1165. LineOut GetResource("L_MsgLicenseStatusExtendedGrace_1")
  1166. Else
  1167. LineOut GetResource("L_MsgActivated_Failed")
  1168. End If
  1169.  
  1170. bFoundAtLeastOneKey = True
  1171. If (strActivationID <> "") Or (iIsPrimaryWindowsSku = 1) Then
  1172. Exit Sub
  1173. End If
  1174. End If
  1175. Next
  1176.  
  1177. If (bFoundAtLeastOneKey = True) Then
  1178. Exit Sub
  1179. End If
  1180.  
  1181. LineOut GetResource("L_MsgErrorProductNotFound")
  1182. End Sub
  1183.  
  1184. Private Sub DisplayKMSInformation(objService, objProduct)
  1185. Dim dwValue
  1186. Dim boolValue
  1187. Dim KeyManagementServiceTotalRequests
  1188.  
  1189. Dim objProductKMSValues
  1190.  
  1191. set objProductKMSValues = GetProductObject( _
  1192. "IsKeyManagementServiceMachine, KeyManagementServiceCurrentCount, " & _
  1193. "KeyManagementServiceTotalRequests, KeyManagementServiceFailedRequests, " & _
  1194. "KeyManagementServiceUnlicensedRequests, KeyManagementServiceLicensedRequests, " & _
  1195. "KeyManagementServiceOOBGraceRequests, KeyManagementServiceOOTGraceRequests, " & _
  1196. "KeyManagementServiceNonGenuineGraceRequests, KeyManagementServiceNotificationRequests", _
  1197. "id = '" & objProduct.ID & "'")
  1198.  
  1199. If objProductKMSValues.IsKeyManagementServiceMachine > 0 Then
  1200. LineOut ""
  1201. LineOut GetResource("L_MsgKmsEnabled")
  1202. LineOut " " & GetResource("L_MsgKmsCurrentCount") & objProductKMSValues.KeyManagementServiceCurrentCount
  1203.  
  1204. dwValue = objService.KeyManagementServiceListeningPort
  1205. If 0 = dwValue Then
  1206. LineOut " " & GetResource("L_MsgKmsListeningOnPort") & DefaultPort
  1207. Else
  1208. LineOut " " & GetResource("L_MsgKmsListeningOnPort") & dwValue
  1209. End If
  1210.  
  1211. boolValue = objService.KeyManagementServiceDnsPublishing
  1212. If true = boolValue Then
  1213. LineOut " " & GetResource("L_MsgKmsDnsPublishingEnabled")
  1214. Else
  1215. LineOut " " & GetResource("L_MsgKmsDnsPublishingDisabled")
  1216. End If
  1217.  
  1218. boolValue = objService.KeyManagementServiceLowPriority
  1219. If false = boolValue Then
  1220. LineOut " " & GetResource("L_MsgKmsPriNormal")
  1221. Else
  1222. LineOut " " & GetResource("L_MsgKmsPriLow")
  1223. End If
  1224.  
  1225. On Error Resume Next
  1226.  
  1227. KeyManagementServiceTotalRequests = objProductKMSValues.KeyManagementServiceTotalRequests
  1228.  
  1229. If (Not(IsNull(KeyManagementServiceTotalRequests))) And (Not(IsEmpty(KeyManagementServiceTotalRequests))) Then
  1230. LineOut ""
  1231. LineOut GetResource("L_MsgKmsCumulativeRequestsFromClients")
  1232. LineOut " " & GetResource("L_MsgKmsTotalRequestsRecieved") & objProductKMSValues.KeyManagementServiceTotalRequests
  1233. LineOut " " & GetResource("L_MsgKmsFailedRequestsReceived") & objProductKMSValues.KeyManagementServiceFailedRequests
  1234. LineOut " " & GetResource("L_MsgKmsRequestsWithStatusUnlicensed") & objProductKMSValues.KeyManagementServiceUnlicensedRequests
  1235. LineOut " " & GetResource("L_MsgKmsRequestsWithStatusLicensed") & objProductKMSValues.KeyManagementServiceLicensedRequests
  1236. LineOut " " & GetResource("L_MsgKmsRequestsWithStatusInitialGrace") & objProductKMSValues.KeyManagementServiceOOBGraceRequests
  1237. LineOut " " & GetResource("L_MsgKmsRequestsWithStatusLicenseExpiredOrHwidOot") & objProductKMSValues.KeyManagementServiceOOTGraceRequests
  1238. LineOut " " & GetResource("L_MsgKmsRequestsWithStatusNonGenuineGrace") & objProductKMSValues.KeyManagementServiceNonGenuineGraceRequests
  1239. LineOut " " & GetResource("L_MsgKmsRequestsWithStatusNotification") & objProductKMSValues.KeyManagementServiceNotificationRequests
  1240. End If
  1241. End If
  1242. End Sub
  1243.  
  1244. Private Sub DisplayADClientInformation(objService, objProduct)
  1245. LineOut ""
  1246. LineOut GetResource("L_MsgVLMostRecentActivationInfo")
  1247. LineOut GetResource("L_MsgADInfo")
  1248.  
  1249. LineOut " " & GetResource("L_MsgADInfoAOName") & objProduct.ADActivationObjectName
  1250. LineOut " " & GetResource("L_MsgADInfoAODN") & objProduct.ADActivationObjectDN
  1251. LineOut " " & GetResource("L_MsgADInfoExtendedPid") & objProduct.ADActivationCsvlkPid
  1252. LineOut " " & GetResource("L_MsgADInfoActID") & objProduct.ADActivationCsvlkSkuId
  1253. End Sub
  1254.  
  1255. Private Sub DisplayTkaClientInformation(objService, objProduct)
  1256. LineOut ""
  1257. LineOut GetResource("L_MsgVLMostRecentActivationInfo")
  1258. LineOut GetResource("L_MsgTkaInfo")
  1259.  
  1260. LineOut " " & Replace(GetResource("L_MsgTkaInfoILID" ), "%ILID%" , objProduct.TokenActivationILID)
  1261. LineOut " " & Replace(GetResource("L_MsgTkaInfoILVID" ), "%ILVID%" , objProduct.TokenActivationILVID)
  1262. LineOut " " & Replace(GetResource("L_MsgTkaInfoGrantNo" ), "%GRANTNO%" , objProduct.TokenActivationGrantNumber)
  1263. LineOut " " & Replace(GetResource("L_MsgTkaInfoThumbprint"), "%THUMBPRINT%", objProduct.TokenActivationCertificateThumbprint)
  1264. End Sub
  1265.  
  1266. Private Sub DisplayKMSClientInformation(objService, objProduct)
  1267. Dim strKms, strIpAddress, strPort, strOutput
  1268. Dim iVLRenewalInterval, iVLActivationInterval
  1269. Dim bFixedKms, bKmsLookupDomain, strKmsLookupDomain
  1270.  
  1271. iVLRenewalInterval = objProduct.VLRenewalInterval
  1272. iVLActivationInterval = objProduct.VLActivationInterval
  1273.  
  1274. LineOut ""
  1275. LineOut GetResource("L_MsgVLMostRecentActivationInfo")
  1276. LineOut GetResource("L_MsgKmsInfo")
  1277. LineOut " " & GetResource("L_MsgCmid") & objService.ClientMachineID
  1278.  
  1279. strKmsLookupDomain = objProduct.KeyManagementServiceLookupDomain
  1280.  
  1281. If strKmsLookupDomain <> "" and Not IsNull(strKmsLookupDomain) Then
  1282. bKmsLookupDomain = True
  1283. LineOut " " & GetResource("L_MsgKmsLookupDomain") & strKmsLookupDomain
  1284. End If
  1285.  
  1286. strKms = objProduct.KeyManagementServiceMachine
  1287.  
  1288. if strKms <> "" And Not IsNull(strKms) Then
  1289. bFixedKms = True
  1290. strPort = objProduct.KeyManagementServicePort
  1291. If (strPort = 0) Then
  1292. strPort = DefaultPort
  1293. End If
  1294. LineOut " " & GetResource("L_MsgRegisteredKmsName") & strKms & ":" & strPort
  1295. Else
  1296. strKms = objProduct.DiscoveredKeyManagementServiceMachineName
  1297. strPort = objProduct.DiscoveredKeyManagementServiceMachinePort
  1298.  
  1299. If IsNull(strKms) Or (strKms = "") Or IsNull(strPort) Or (strPort = 0) Then
  1300. LineOut " " & GetResource("L_MsgKmsFromDnsUnavailable")
  1301. Else
  1302. LineOut " " & GetResource("L_MsgKmsFromDns") & strKms & ":" & strPort
  1303. End If
  1304. End If
  1305.  
  1306. strIpAddress = objProduct.DiscoveredKeyManagementServiceMachineIpAddress
  1307.  
  1308. If IsNull(strIpAddress) Or (strIpAddress = "") Then
  1309. LineOut " " & GetResource("L_MsgKmsIpAddressUnavailable")
  1310. Else
  1311. LineOut " " & GetResource("L_MsgKmsIpAddress") & strIpAddress
  1312. End If
  1313.  
  1314. LineOut " " & GetResource("L_MsgKmsPID4") & objProduct.KeyManagementServiceProductKeyID
  1315. strOutput = Replace(GetResource("L_MsgActivationInterval"), "%INTERVAL%", iVLActivationInterval)
  1316. LineOut " " & strOutput
  1317. strOutput = Replace(GetResource("L_MsgRenewalInterval"), "%INTERVAL%", iVLRenewalInterval)
  1318. LineOut " " & strOutput
  1319.  
  1320. if (objService.KeyManagementServiceHostCaching = True) Then
  1321. LineOut " " & GetResource("L_MsgKmsHostCachingEnabled")
  1322. Else
  1323. LineOut " " & GetResource("L_MsgKmsHostCachingDisabled")
  1324. End If
  1325.  
  1326. If bKmsLookupDomain And bFixedKms Then
  1327. LineOut ""
  1328. LineOut Replace(GetResource("L_MsgKmsUseMachineNameOverrides"), "%KMS%", strKms & ":" & strPort)
  1329. End If
  1330. End Sub
  1331.  
  1332. Private Sub DisplayAVMAClientInformation(objProduct)
  1333. Dim strHostName, strPid
  1334. Dim displayDate
  1335. Dim bHostName, bFiletime, bPid
  1336.  
  1337. strHostName = objProduct.AutomaticVMActivationHostMachineName
  1338. bHostName = strHostName <> "" And Not IsNull(strHostName)
  1339.  
  1340. Set displayDate = CreateObject("WBemScripting.SWbemDateTime")
  1341. displayDate.Value = objProduct.AutomaticVMActivationLastActivationTime
  1342. bFiletime = displayDate.GetFileTime(false) <> 0
  1343.  
  1344. strPid = objProduct.AutomaticVMActivationHostDigitalPid2
  1345. bPid = strPid <> "" And Not IsNull(strPid)
  1346.  
  1347. If bHostName Or bFiletime Or bPid Then
  1348. LineOut ""
  1349. LineOut GetResource("L_MsgVLMostRecentActivationInfo")
  1350. LineOut GetResource("L_MsgAVMAInfo")
  1351.  
  1352. If bHostName Then
  1353. LineOut " " & GetResource("L_MsgAVMAHostMachineName") & strHostName
  1354. Else
  1355. LineOut " " & GetResource("L_MsgAVMAHostMachineName") & GetResource("L_MsgNotAvailable")
  1356. End If
  1357.  
  1358. If bFiletime Then
  1359. LineOut " " & GetResource("L_MsgAVMALastActTime") & displayDate.GetVarDate
  1360. Else
  1361. LineOut " " & GetResource("L_MsgAVMALastActTime") & GetResource("L_MsgNotAvailable")
  1362. End If
  1363.  
  1364. If bPid Then
  1365. LineOut " " & GetResource("L_MsgAVMAHostPid2") & strPid
  1366. Else
  1367. LineOut " " & GetResource("L_MsgAVMAHostPid2") & GetResource("L_MsgNotAvailable")
  1368. End If
  1369. End If
  1370.  
  1371. End Sub
  1372.  
  1373. '
  1374. ' Display all information for /dlv and /dli
  1375. ' If you add need to access new properties through WMI you must add them to the
  1376. ' queries for service/object. Be sure to check that the object properties in DisplayAllInformation()
  1377. ' are requested for function/methods such as GetIsPrimaryWindowsSKU() and DisplayKMSClientInformation().
  1378. '
  1379. Private Sub DisplayAllInformation(strParm, bVerbose)
  1380. Dim objService, objProduct
  1381. Dim strServiceSelectClause
  1382. Dim objProductIter, strIterSelectClause, strProductSelectClause
  1383. Dim strDescription, bKmsClient, strSLActID, bKmsServer, bTBL
  1384. Dim strAVMAId, bAVMA
  1385. Dim ls, gpMin, gpDay, displayDate
  1386. Dim strOutput
  1387. Dim strUrl
  1388. Dim bShowSkuInformation
  1389. Dim iIsPrimaryWindowsSku, bUseDefault
  1390. Dim productKeyFound
  1391.  
  1392. Dim strErr
  1393. strParm = LCase(strParm)
  1394. productKeyFound = False
  1395.  
  1396. strServiceSelectClause = _
  1397. "KeyManagementServiceListeningPort, KeyManagementServiceDnsPublishing, " & _
  1398. "KeyManagementServiceLowPriority, ClientMachineId, KeyManagementServiceHostCaching, " & _
  1399. "Version"
  1400.  
  1401. strProductSelectClause = _
  1402. ProductIsPrimarySkuSelectClause & ", " & _
  1403. "ProductKeyID, ProductKeyChannel, OfflineInstallationId, " & _
  1404. "ProcessorURL, MachineURL, UseLicenseURL, ProductKeyURL, ValidationURL, " & _
  1405. "GracePeriodRemaining, LicenseStatus, LicenseStatusReason, EvaluationEndDate, " & _
  1406. "VLRenewalInterval, VLActivationInterval, KeyManagementServiceLookupDomain, KeyManagementServiceMachine, " & _
  1407. "KeyManagementServicePort, DiscoveredKeyManagementServiceMachineName, " & _
  1408. "DiscoveredKeyManagementServiceMachinePort, DiscoveredKeyManagementServiceMachineIpAddress, KeyManagementServiceProductKeyID," & _
  1409. "TokenActivationILID, TokenActivationILVID, TokenActivationGrantNumber," & _
  1410. "TokenActivationCertificateThumbprint, TokenActivationAdditionalInfo, TrustedTime," & _
  1411. "ADActivationObjectName, ADActivationObjectDN, ADActivationCsvlkPid, ADActivationCsvlkSkuId, VLActivationTypeEnabled, VLActivationType," & _
  1412. "IAID, AutomaticVMActivationHostMachineName, AutomaticVMActivationLastActivationTime, AutomaticVMActivationHostDigitalPid2"
  1413.  
  1414. If bVerbose Then
  1415. strServiceSelectClause = "RemainingWindowsReArmCount, " & strServiceSelectClause
  1416. strProductSelectClause = "RemainingAppReArmCount, RemainingSkuReArmCount, " & strProductSelectClause
  1417. End If
  1418.  
  1419. set objService = GetServiceObject(strServiceSelectClause)
  1420.  
  1421. If bVerbose Then
  1422. LineOut GetResource("L_MsgServiceVersion") & objService.Version
  1423. End If
  1424.  
  1425. If (strParm = "all") Then
  1426. strIterSelectClause = strProductSelectClause
  1427. Else
  1428. strIterSelectClause = ProductIsPrimarySkuSelectClause
  1429. End If
  1430.  
  1431. For Each objProductIter in GetProductCollection(strIterSelectClause, EmptyWhereClause)
  1432.  
  1433. strSLActID = objProductIter.ID
  1434.  
  1435. ' Display information if:
  1436. ' parm = "all" or
  1437. ' ActID = parm or
  1438. ' default to current ActID (parm = "" and IsPrimaryWindowsSKU is 1 or 2)
  1439. iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProductIter)
  1440. bUseDefault = False
  1441. bShowSkuInformation = False
  1442.  
  1443. If (strParm = "" And ((iIsPrimaryWindowsSku = 1) Or (iIsPrimaryWindowsSku = 2))) Then
  1444. bUseDefault = True
  1445. bShowSkuInformation = True
  1446. End If
  1447.  
  1448. If (strParm = "" And (objProductIter.LicenseIsAddon And objProductIter.PartialProductKey <> "")) Then
  1449. bShowSkuInformation = True
  1450. End If
  1451.  
  1452. If (strParm = "all") Then
  1453. bShowSkuInformation = True
  1454. End If
  1455.  
  1456. If (strParm = LCase(strSLActID)) Then
  1457. bShowSkuInformation = True
  1458. End If
  1459.  
  1460. If (bShowSkuInformation) Then
  1461.  
  1462. If (strParm = "all") Then
  1463. set objProduct = objProductIter
  1464. Else
  1465. set objProduct = GetProductObject(strProductSelectClause, "id = '" & objProductIter.ID & "'")
  1466. End If
  1467.  
  1468. strDescription = objProduct.Description
  1469.  
  1470. 'If the user didn't specify anything and we are showing the default case, warn them
  1471. ' if this can't be verified as the primary SKU
  1472. If ((bUseDefault = True) And (iIsPrimaryWindowsSku = 2)) Then
  1473. OutputIndeterminateOperationWarning(objProduct)
  1474. End IF
  1475.  
  1476. productKeyFound = True
  1477.  
  1478. LineOut ""
  1479. LineOut GetResource("L_MsgProductName") & objProduct.Name
  1480.  
  1481. LineOut GetResource("L_MsgProductDesc") & strDescription
  1482.  
  1483. If objProduct.TokenActivationAdditionalInfo <> "" Then
  1484. LineOut Replace( _
  1485. GetResource("L_MsgTkaInfoAdditionalInfo"), _
  1486. "%MOREINFO%", _
  1487. objProduct.TokenActivationAdditionalInfo _
  1488. )
  1489. End If
  1490.  
  1491. bKmsServer = IsKmsServer(strDescription)
  1492. bKmsClient = IsKmsClient(strDescription)
  1493. bTBL = IsTBL(strDescription)
  1494. bAVMA = IsAVMA(strDescription)
  1495.  
  1496. If bVerbose Then
  1497. LineOut GetResource("L_MsgActID") & strSLActID
  1498. LineOut GetResource("L_MsgAppID") & objProduct.ApplicationID
  1499. LineOut GetResource("L_MsgPID4") & objProduct.ProductKeyID
  1500. LineOut GetResource("L_MsgChannel") & objProduct.ProductKeyChannel
  1501. LineOut GetResource("L_MsgInstallationID") & objProduct.OfflineInstallationId
  1502.  
  1503. If (NOT bKmsClient) AND (NOT bAVMA) Then
  1504.  
  1505. 'Note that we are re-using the UseLicenseURL for the Product Activation
  1506. 'URL for down-level compatibility reasons
  1507.  
  1508. strUrl = objProduct.ProcessorURL
  1509. If strUrl <> "" Then
  1510. LineOut GetResource("L_MsgProcessorCertUrl") & strUrl
  1511. End If
  1512.  
  1513. strUrl = objProduct.MachineURL
  1514. If strUrl <> "" Then
  1515. LineOut GetResource("L_MsgMachineCertUrl") & strUrl
  1516. End If
  1517.  
  1518. strUrl = objProduct.UseLicenseURL
  1519. If strUrl <> "" Then
  1520. LineOut GetResource("L_MsgUseLicenseCertUrl") & strUrl
  1521. End If
  1522.  
  1523. strUrl = objProduct.ProductKeyURL
  1524. If strUrl <> "" Then
  1525. LineOut GetResource("L_MsgPKeyCertUrl") & strUrl
  1526. End If
  1527.  
  1528. strUrl = objProduct.ValidationURL
  1529. If strUrl <> "" Then
  1530. LineOut GetResource("L_MsgValidationUrl") & strUrl
  1531. End If
  1532.  
  1533. End If
  1534. End If
  1535.  
  1536. If objProduct.PartialProductKey <> "" Then
  1537. LineOut GetResource("L_MsgPartialPKey") & objProduct.PartialProductKey
  1538. Else
  1539. LineOut GetResource("L_MsgErrorLicenseNotInUse")
  1540. End If
  1541.  
  1542. ls = objProduct.LicenseStatus
  1543.  
  1544. If ls = 0 Then
  1545. LineOut GetResource("L_MsgLicenseStatusUnlicensed_1")
  1546.  
  1547. ElseIf ls = 1 Then
  1548. LineOut GetResource("L_MsgLicenseStatusLicensed_1")
  1549. gpMin = objProduct.GracePeriodRemaining
  1550. If (gpMin <> 0) Then
  1551. gpDay = GetDaysFromMins(gpMin)
  1552. If (bTBL) Then
  1553. strOutput = Replace(GetResource("L_MsgLicenseStatusTBL_1"), "%MINUTE%", gpMin)
  1554. ElseIf (bAVMA) Then
  1555. strOutput = Replace(GetResource("L_MsgLicenseStatusAVMA_1"), "%MINUTE%", gpMin)
  1556. Else
  1557. strOutput = Replace(GetResource("L_MsgLicenseStatusVL_1"), "%MINUTE%", gpMin)
  1558. End If
  1559. strOutput = Replace(strOutput, "%DAY%", gpDay)
  1560. LineOut strOutput
  1561. End If
  1562.  
  1563. ElseIf ls = 2 Then
  1564. LineOut GetResource("L_MsgLicenseStatusInitialGrace_1")
  1565. gpMin = objProduct.GracePeriodRemaining
  1566. gpDay = GetDaysFromMins(gpMin)
  1567. strOutput = Replace(GetResource("L_MsgLicenseStatusTimeRemaining"), "%MINUTE%", gpMin)
  1568. strOutput = Replace(strOutput, "%DAY%", gpDay)
  1569. LineOut strOutput
  1570.  
  1571. ElseIf ls = 3 Then
  1572. LineOut GetResource("L_MsgLicenseStatusAdditionalGrace_1")
  1573. gpMin = objProduct.GracePeriodRemaining
  1574. gpDay = GetDaysFromMins(gpMin)
  1575. strOutput = Replace(GetResource("L_MsgLicenseStatusTimeRemaining"), "%MINUTE%", gpMin)
  1576. strOutput = Replace(strOutput, "%DAY%", gpDay)
  1577. LineOut strOutput
  1578.  
  1579. ElseIf ls = 4 Then
  1580. LineOut GetResource("L_MsgLicenseStatusNonGenuineGrace_1")
  1581. gpMin = objProduct.GracePeriodRemaining
  1582. gpDay = GetDaysFromMins(gpMin)
  1583. strOutput = Replace(GetResource("L_MsgLicenseStatusTimeRemaining"), "%MINUTE%", gpMin)
  1584. strOutput = Replace(strOutput, "%DAY%", gpDay)
  1585. LineOut strOutput
  1586.  
  1587. ElseIf ls = 5 Then
  1588. LineOut GetResource("L_MsgLicenseStatusNotification_1")
  1589. strErr = CStr(Hex(objProduct.LicenseStatusReason))
  1590. if (objProduct.LicenseStatusReason = HR_SL_E_NOT_GENUINE) Then
  1591. strOutput = Replace(GetResource("L_MsgNotificationErrorReasonNonGenuine"), "%ERRCODE%", strErr)
  1592. ElseIf (objProduct.LicenseStatusReason = HR_SL_E_GRACE_TIME_EXPIRED) Then
  1593. strOutput = Replace(GetResource("L_MsgNotificationErrorReasonExpiration"), "%ERRCODE%", strErr)
  1594. Else
  1595. strOutput = Replace(GetResource("L_MsgNotificationErrorReasonOther"), "%ERRCODE%", strErr)
  1596. End If
  1597. LineOut strOutput
  1598.  
  1599. ElseIf ls = 6 Then
  1600. LineOut GetResource("L_MsgLicenseStatusExtendedGrace_1")
  1601. gpMin = objProduct.GracePeriodRemaining
  1602. gpDay = GetDaysFromMins(gpMin)
  1603. strOutput = Replace(GetResource("L_MsgLicenseStatusTimeRemaining"), "%MINUTE%", gpMin)
  1604. strOutput = Replace(strOutput, "%DAY%", gpDay)
  1605. LineOut strOutput
  1606.  
  1607. Else
  1608. LineOut GetResource("L_MsgLicenseStatusUnknown")
  1609. End If
  1610.  
  1611. If (ls <> 0 And bVerbose) Then
  1612. Set displayDate = CreateObject("WBemScripting.SWbemDateTime")
  1613. displayDate.Value = objProduct.EvaluationEndDate
  1614. If (displayDate.GetFileTime(false) <> 0) Then
  1615. LineOut GetResource("L_MsgLicenseStatusEvalEndData") & displayDate.GetVarDate
  1616. End If
  1617. End If
  1618.  
  1619. If (bVerbose) Then
  1620. If (LCase(objProduct.ApplicationId) = WindowsAppId) Then
  1621. LineOut Replace(GetResource("L_MsgRemainingWindowsRearmCount"), "%COUNT%", objService.RemainingWindowsReArmCount)
  1622. Else
  1623. LineOut Replace(GetResource("L_MsgRemainingAppRearmCount"), "%COUNT%", objProduct.RemainingAppReArmCount)
  1624. End If
  1625. LineOut Replace(GetResource("L_MsgRemainingSkuRearmCount"), "%COUNT%", objProduct.RemainingSkuReArmCount)
  1626.  
  1627. Set displayDate = CreateObject("WBemScripting.SWbemDateTime")
  1628. displayDate.Value = objProduct.TrustedTime
  1629. If (displayDate.GetFileTime(false) <> 0) Then
  1630. LineOut GetResource("L_MsgCurrentTrustedTime") & displayDate.GetVarDate
  1631. End If
  1632.  
  1633. End If
  1634.  
  1635. '
  1636. ' KMS client properties
  1637. '
  1638.  
  1639. If bKmsClient Then
  1640.  
  1641. If (objProduct.VLActivationTypeEnabled = 1) Then
  1642. LineOut GetResource("L_MsgVLActivationTypeAD")
  1643. ElseIf (objProduct.VLActivationTypeEnabled = 2) Then
  1644. LineOut GetResource("L_MsgVLActivationTypeKMS")
  1645. ElseIf (objProduct.VLActivationTypeEnabled = 3) Then
  1646. LineOut GetResource("L_MsgVLActivationTypeToken")
  1647. Else
  1648. LineOut GetResource("L_MsgVLActivationTypeAll")
  1649. End If
  1650.  
  1651. If IsADActivated(objProduct) Then
  1652. DisplayADClientInformation objService, objProduct
  1653. ElseIf IsTokenActivated(objProduct) Then
  1654. DisplayTkaClientInformation objService, objProduct
  1655. ElseIf ls <> 1 Then
  1656. LineOut GetResource("L_MsgPleaseActivateRefreshKMSInfo")
  1657. Else
  1658. DisplayKMSClientInformation objService, objProduct
  1659. End If
  1660. End If
  1661.  
  1662. If (bKmsServer Or (iIsPrimaryWindowsSku = 1) Or (iIsPrimaryWindowsSku = 2)) Then
  1663. DisplayKMSInformation objService, objProduct
  1664. End If
  1665.  
  1666. If (bAVMA) Then
  1667. strAVMAId = objProduct.IAID
  1668.  
  1669. If strAVMAId <> "" And Not IsNull(strAVMAId) Then
  1670. LineOut GetResource("L_MsgAVMAID") & strAVMAId
  1671. Else
  1672. LineOut GetResource("L_MsgAVMAID") & GetResource("L_MsgNotAvailable")
  1673. End If
  1674.  
  1675. DisplayAVMAClientInformation objProduct
  1676. End If
  1677.  
  1678. 'We should stop processing if we aren't processing All and either we were told to process a single
  1679. 'entry only or we found the primary SKU
  1680. If strParm <> "all" Then
  1681. If (strParm = LCase(strSLActID)) Then
  1682. Exit For 'no need to continue
  1683. End If
  1684. End If
  1685.  
  1686. LineOut ""
  1687. End If
  1688. Next
  1689.  
  1690. If productKeyFound = False Then
  1691. LineOut GetResource("L_MsgErrorPKey")
  1692. End If
  1693.  
  1694. End Sub
  1695.  
  1696. Private Function GetDaysFromMins(iMins)
  1697. Dim iMinsInADay
  1698. iMinsInADay = 24 * 60
  1699. ' VBScript only supports Int truncation or 'evens' rounding, it does not support a CEILING/FLOOR operation or MOD
  1700. ' To simulate the CEILING operation used for other grace-day calculations in the UX we need to add the # of mins
  1701. ' in a day minus 1 to the input then divide by the mins in a day
  1702. GetDaysFromMins = Int((iMins + iMinsInADay - 1) / iMinsInADay)
  1703. End Function
  1704.  
  1705. Private Sub InstallProductKey(strProductKey)
  1706. Dim objService, objProduct
  1707. Dim lRet, strDescription, strOutput, strVersion
  1708. Dim iIsPrimaryWindowsSku, bIsKMS
  1709.  
  1710. bIsKMS = False
  1711.  
  1712. On Error Resume Next
  1713.  
  1714. set objService = GetServiceObject("Version")
  1715. strVersion = objService.Version
  1716. objService.InstallProductKey(strProductKey)
  1717. QuitIfError()
  1718.  
  1719. ' Installing a product key could change Windows licensing state.
  1720. ' Since the service determines if it can shut down and when is the next start time
  1721. ' based on the licensing state we should reconsume the licenses here.
  1722. objService.RefreshLicenseStatus()
  1723.  
  1724. For Each objProduct in GetProductCollection(ProductIsPrimarySkuSelectClause, PartialProductKeyNonNullWhereClause)
  1725. strDescription = objProduct.Description
  1726.  
  1727. iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct)
  1728. If (iIsPrimaryWindowsSku = 2) Then
  1729. OutputIndeterminateOperationWarning(objProduct)
  1730. End If
  1731.  
  1732. If IsKmsServer(strDescription) Then
  1733. bIsKMS = True
  1734. Exit For
  1735. End If
  1736. Next
  1737.  
  1738. If (bIsKMS = True) Then
  1739. ' Set the KMS version in the registry (64 and 32 bit versions)
  1740. lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceVersion", strVersion)
  1741. If (lRet <> 0) Then
  1742. QuitWithError lRet
  1743. End If
  1744.  
  1745. If ExistsRegistryKey(HKEY_LOCAL_MACHINE, SLKeyPath32) Then
  1746. lRet = SetRegistryStr(HKEY_LOCAL_MACHINE, SLKeyPath32, "KeyManagementServiceVersion", strVersion)
  1747. If (lRet <> 0) Then
  1748. QuitWithError lRet
  1749. End If
  1750. End If
  1751. Else
  1752. ' Clear the KMS version in the registry (64 and 32 bit versions)
  1753. lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath, "KeyManagementServiceVersion")
  1754. If (lRet <> 0 And lRet <> 2 And lRet <> 5) Then
  1755. QuitWithError lRet
  1756. End If
  1757.  
  1758. lRet = DeleteRegistryValue(HKEY_LOCAL_MACHINE, SLKeyPath32, "KeyManagementServiceVersion")
  1759. If (lRet <> 0 And lRet <> 2 And lRet <> 5) Then
  1760. QuitWithError lRet
  1761. End If
  1762. End If
  1763.  
  1764. strOutput = Replace(GetResource("L_MsgInstalledPKey"), "%PKEY%", strProductKey)
  1765. LineOut strOutput
  1766. End Sub
  1767.  
  1768. Private Sub OutputIndeterminateOperationWarning(objProduct)
  1769. Dim strOutput
  1770.  
  1771. LineOut GetResource("L_MsgUndeterminedPrimaryKeyOperation")
  1772. strOutput = Replace(GetResource("L_MsgUndeterminedOperationFormat"), "%PRODUCTDESCRIPTION%", objProduct.Description)
  1773. strOutput = Replace(strOutput, "%PRODUCTID%", objProduct.ID)
  1774. LineOut strOutput
  1775. End Sub
  1776.  
  1777. Private Sub ClearPKeyFromRegistry()
  1778. Dim objService
  1779.  
  1780. On Error Resume Next
  1781.  
  1782. set objService = GetServiceObject("Version")
  1783. QuitIfError()
  1784.  
  1785. objService.ClearProductKeyFromRegistry()
  1786. QuitIfError()
  1787.  
  1788. LineOut GetResource("L_MsgClearedPKey")
  1789. End Sub
  1790.  
  1791. Private Sub InstallLicenseFiles (strParentDirectory, fso)
  1792. Dim file, files, folder, subFolder
  1793.  
  1794. Set folder = fso.GetFolder(strParentDirectory)
  1795. Set files = folder.Files
  1796.  
  1797. ' Install all license files in folder
  1798. For Each file In files
  1799. If Right(file.Name, 7) = ".xrm-ms" Then
  1800. InstallLicense strParentDirectory & "\" & file.Name
  1801. End If
  1802. Next
  1803.  
  1804. For Each subFolder in folder.SubFolders
  1805. InstallLicenseFiles subFolder, fso
  1806. Next
  1807. End Sub
  1808.  
  1809. Private Sub ReinstallLicenses()
  1810. Dim shell, fso, strOemFolder
  1811. Dim strSppTokensFolder, folder, subFolder
  1812. Set shell = WScript.CreateObject("WScript.Shell")
  1813. Set fso = CreateObject("Scripting.FileSystemObject")
  1814.  
  1815. strOemFolder = shell.ExpandEnvironmentStrings("%SystemRoot%") & "\system32\oem"
  1816. strSppTokensFolder = shell.ExpandEnvironmentStrings("%SystemRoot%") & "\system32\spp\tokens"
  1817.  
  1818. LineOut GetResource("L_MsgReinstallingLicenses")
  1819.  
  1820. Set folder = fso.GetFolder(strSppTokensFolder)
  1821.  
  1822. For Each subFolder in folder.SubFolders
  1823. InstallLicenseFiles subFolder, fso
  1824. Next
  1825.  
  1826. If (fso.FolderExists(strOemFolder)) Then
  1827. InstallLicenseFiles strOemFolder, fso
  1828. End If
  1829.  
  1830. LineOut GetResource("L_MsgLicensesReinstalled")
  1831. End Sub
  1832.  
  1833. Private Sub ReArmWindows
  1834. Dim objService
  1835.  
  1836. set objService = GetServiceObject("Version")
  1837. On Error Resume Next
  1838.  
  1839. objService.ReArmWindows()
  1840. QuitIfError()
  1841.  
  1842. LineOut GetResource("L_MsgRearm_1")
  1843. LineOut GetResource("L_MsgRearm_2")
  1844. End Sub
  1845.  
  1846. Private Sub ReArmApp(strSLID)
  1847. Dim objService
  1848.  
  1849. set objService = GetServiceObject("Version")
  1850. QuitIfError()
  1851.  
  1852. objService.ReArmApp(strSLID)
  1853. QuitIfError()
  1854.  
  1855. LineOut GetResource("L_MsgRearm_1")
  1856. End Sub
  1857.  
  1858. Private Sub ReArmSku(strSLID)
  1859. Dim objProductIter
  1860. Dim strSLActID
  1861. Dim strWhereClause
  1862. Dim bSkuFound
  1863.  
  1864. strSLID = LCase(strSLID)
  1865.  
  1866. bSkuFound = False
  1867.  
  1868. strWhereClause = "ID = '" & strSLID & "'"
  1869.  
  1870. For Each objProductIter in GetProductCollection("ID", strWhereClause)
  1871. strSLActID = objProductIter.ID
  1872.  
  1873. If (strSLID = LCase(strSLActID)) Then
  1874. bSkuFound = True
  1875. objProductIter.ReArmsku()
  1876. QuitIfError()
  1877. LineOut GetResource("L_MsgRearm_1")
  1878. Exit For
  1879. End If
  1880. Next
  1881.  
  1882. If (bSkuFound = False) Then
  1883. LineOut GetResource("L_MsgErrorProductNotFound")
  1884. End If
  1885.  
  1886. End Sub
  1887.  
  1888. Private Sub ExpirationDatime(strActivationID)
  1889. Dim strWhereClause
  1890. Dim objProduct
  1891. Dim strSLActID, ls, graceRemaining, strEnds
  1892. Dim strOutput
  1893. Dim strDescription, bTBL, bAVMA
  1894. Dim iIsPrimaryWindowsSku
  1895. Dim bFound
  1896.  
  1897. strActivationID = LCase(strActivationID)
  1898.  
  1899. bFound = False
  1900.  
  1901. If strActivationId = "" Then
  1902. strWhereClause = "ApplicationId = '" & WindowsAppId & "'"
  1903. Else
  1904. strWhereClause = "ID = '" & Replace(strActivationID, "'", "") & "'"
  1905. End If
  1906.  
  1907. strWhereClause = strWhereClause & " AND " & PartialProductKeyNonNullWhereClause
  1908.  
  1909. For Each objProduct in GetProductCollection(ProductIsPrimarySkuSelectClause & ", LicenseStatus, GracePeriodRemaining", strWhereClause)
  1910.  
  1911. strSLActID = objProduct.ID
  1912. ls = objProduct.LicenseStatus
  1913. graceRemaining = objProduct.GracePeriodRemaining
  1914. strEnds = DateAdd("n", graceRemaining, Now)
  1915.  
  1916. bFound = True
  1917.  
  1918. iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct)
  1919. If (strActivationID = "") And (iIsPrimaryWindowsSku = 2) Then
  1920. OutputIndeterminateOperationWarning(objProduct)
  1921. End If
  1922.  
  1923. strOutput = ""
  1924.  
  1925. If ls = 0 Then
  1926. strOutput = GetResource("L_MsgLicenseStatusUnlicensed")
  1927.  
  1928. ElseIf ls = 1 Then
  1929. If graceRemaining <> 0 Then
  1930.  
  1931. strDescription = objProduct.Description
  1932.  
  1933. bTBL = IsTBL(strDescription)
  1934.  
  1935. bAVMA = IsAVMA(strDescription)
  1936.  
  1937. If bTBL Then
  1938. strOutput = Replace(GetResource("L_MsgLicenseStatusTBL"), "%ENDDATE%", strEnds)
  1939. ElseIf bAVMA Then
  1940. strOutput = Replace(GetResource("L_MsgLicenseStatusAVMA"), "%ENDDATE%", strEnds)
  1941. Else
  1942. strOutput = Replace(GetResource("L_MsgLicenseStatusVL"), "%ENDDATE%", strEnds)
  1943. End If
  1944. Else
  1945. strOutput = GetResource("L_MsgLicenseStatusLicensed")
  1946. End If
  1947.  
  1948. ElseIf ls = 2 Then
  1949. strOutput = Replace(GetResource("L_MsgLicenseStatusInitialGrace"), "%ENDDATE%", strEnds)
  1950. ElseIf ls = 3 Then
  1951. strOutput = Replace(GetResource("L_MsgLicenseStatusAdditionalGrace"), "%ENDDATE%", strEnds)
  1952. ElseIf ls = 4 Then
  1953. strOutput = Replace(GetResource("L_MsgLicenseStatusNonGenuineGrace"), "%ENDDATE%", strEnds)
  1954. ElseIf ls = 5 Then
  1955. strOutput = GetResource("L_MsgLicenseStatusNotification")
  1956. ElseIf ls = 6 Then
  1957. strOutput = Replace(GetResource("L_MsgLicenseStatusExtendedGrace"), "%ENDDATE%", strEnds)
  1958. End If
  1959.  
  1960. If strOutput <> "" Then
  1961. LineOut objProduct.Name & ":"
  1962. Lineout " " & strOutput
  1963. End If
  1964. Next
  1965.  
  1966. If True <> bFound Then
  1967. LineOut GetResource("L_MsgErrorPKey")
  1968. End If
  1969. End Sub
  1970.  
  1971. ''
  1972. '' Volume license service/client management
  1973. ''
  1974.  
  1975. Private Sub QuitIfErrorRestoreKmsName(obj, strKmsName)
  1976. Dim objErr
  1977.  
  1978. If Err.Number <> 0 Then
  1979. set objErr = new CErr
  1980.  
  1981. If strKmsName = "" Then
  1982. obj.ClearKeyManagementServiceMachine()
  1983. Else
  1984. obj.SetKeyManagementServiceMachine(strKmsName)
  1985. End If
  1986.  
  1987. ShowError GetResource("L_MsgErrorText_8"), objErr
  1988. ExitScript objErr.Number
  1989. End If
  1990. End Sub
  1991.  
  1992. Private Function GetKmsClientObjectByActivationID(strActivationID)
  1993. Dim objProduct, objTarget
  1994.  
  1995. strActivationID = LCase(strActivationID)
  1996.  
  1997. Set objTarget = Nothing
  1998.  
  1999. On Error Resume Next
  2000.  
  2001. If strActivationID = "" Then
  2002. Set objTarget = GetServiceObject("Version, " & KMSClientLookupClause)
  2003. QuitIfError()
  2004. Else
  2005. For Each objProduct in GetProductCollection("ID, " & KMSClientLookupClause, EmptyWhereClause)
  2006. If (LCase(objProduct.ID) = strActivationID) Then
  2007. Set objTarget = objProduct
  2008. Exit For
  2009. End If
  2010. Next
  2011.  
  2012. If objTarget is Nothing Then
  2013. Lineout Replace(GetResource("L_MsgErrorActivationID"), "%ActID%", strActivationID)
  2014. End If
  2015. End If
  2016.  
  2017. Set GetKmsClientObjectByActivationID = objTarget
  2018. End Function
  2019.  
  2020. Private Sub SetKmsMachineName(strKmsNamePort, strActivationID)
  2021. Dim objTarget
  2022. Dim nColon, strKmsName, strKmsNamePrev, strKmsPort, nBracketEnd
  2023. Dim nKmsPort
  2024.  
  2025. nBracketEnd = InStr(StrKmsNamePort, "]")
  2026. If InStr(strKmsNamePort, "[") = 1 And nBracketEnd > 1 Then
  2027. ' IPV6 Address
  2028. If Len(StrKmsNamePort) = nBracketEnd Then
  2029. 'No Port Number
  2030. strKmsName = strKmsNamePort
  2031. strKmsPort = ""
  2032. Else
  2033. strKmsName = Left(strKmsNamePort, nBracketEnd)
  2034. strKmsPort = Right(strKmsNamePort, Len(strKmsNamePort) - nBracketEnd - 1)
  2035. End If
  2036. Else
  2037. ' IPV4 Address
  2038. nColon = InStr(1, strKmsNamePort, ":")
  2039. If nColon <> 0 Then
  2040. strKmsName = Left(strKmsNamePort, nColon - 1)
  2041. strKmsPort = Right(strKmsNamePort, Len(strKmsNamePort) - nColon)
  2042. Else
  2043. strKmsName = strKmsNamePort
  2044. strKmsPort = ""
  2045. End If
  2046. End If
  2047.  
  2048. Set objTarget = GetKmsClientObjectByActivationID(strActivationID)
  2049.  
  2050. On Error Resume Next
  2051.  
  2052. If Not objTarget is Nothing Then
  2053. strKmsNamePrev = objTarget.KeyManagementServiceMachine
  2054.  
  2055. If strKmsName <> "" Then
  2056. objTarget.SetKeyManagementServiceMachine(strKmsName)
  2057. QuitIfError()
  2058. End If
  2059.  
  2060. If strKmsPort <> "" Then
  2061. nKmsPort = CLng(strKmsPort)
  2062. QuitIfErrorRestoreKmsName objTarget, strKmsNamePrev
  2063. objTarget.SetKeyManagementServicePort(nKmsPort)
  2064. QuitIfErrorRestoreKmsName objTarget, strKmsNamePrev
  2065. Else
  2066. objTarget.ClearKeyManagementServicePort()
  2067. QuitIfErrorRestoreKmsName objTarget, strKmsNamePrev
  2068. End If
  2069.  
  2070. LineOut Replace(GetResource("L_MsgKmsNameSet"), "%KMS%", strKmsNamePort)
  2071.  
  2072. If objTarget.KeyManagementServiceLookupDomain <> "" Then
  2073. LineOut Replace(GetResource("L_MsgKmsUseMachineNameOverrides"), _
  2074. "%KMS%", _
  2075. strKmsNamePort)
  2076. End If
  2077. End If
  2078. End Sub
  2079.  
  2080. Private Sub ClearKms(strActivationID)
  2081. Dim objTarget
  2082.  
  2083. Set objTarget = GetKmsClientObjectByActivationID(strActivationID)
  2084.  
  2085. On Error Resume Next
  2086.  
  2087. If Not objTarget is Nothing Then
  2088. objTarget.ClearKeyManagementServiceMachine()
  2089. QuitIfError()
  2090. objTarget.ClearKeyManagementServicePort()
  2091. QuitIfError()
  2092.  
  2093. LineOut GetResource("L_MsgKmsNameCleared")
  2094.  
  2095. If objTarget.KeyManagementServiceLookupDomain <> "" Then
  2096. LineOut Replace(GetResource("L_MsgKmsUseLookupDomain"), _
  2097. "%FQDN%", _
  2098. objTarget.KeyManagementServiceLookupDomain)
  2099. End If
  2100. End If
  2101. End Sub
  2102.  
  2103. Private Sub SetKmsLookupDomain(strKmsLookupDomain, strActivationID)
  2104. Dim objTarget
  2105. Dim strKms, nPort
  2106.  
  2107. Set objTarget = GetKmsClientObjectByActivationID(strActivationID)
  2108.  
  2109. On Error Resume Next
  2110.  
  2111. If Not objTarget is Nothing Then
  2112. objTarget.SetKeyManagementServiceLookupDomain(strKmsLookupDomain)
  2113. QuitIfError()
  2114.  
  2115. LineOut Replace(GetResource("L_MsgKmsLookupDomainSet"), "%FQDN%", strKmsLookupDomain)
  2116.  
  2117. If objTarget.KeyManagementServiceMachine <> "" Then
  2118. strKms = objTarget.KeyManagementServiceMachine
  2119. nPort = objTarget.KeyManagementServicePort
  2120. LineOut Replace(GetResource("L_MsgKmsUseMachineNameOverrides"), _
  2121. "%KMS%", strKms & ":" & nPort)
  2122. End If
  2123. End If
  2124. End Sub
  2125.  
  2126. Private Sub ClearKmsLookupDomain(strActivationID)
  2127. Dim objTarget
  2128. Dim strKms, nPort
  2129.  
  2130. Set objTarget = GetKmsClientObjectByActivationID(strActivationID)
  2131.  
  2132. On Error Resume Next
  2133.  
  2134. If Not objTarget is Nothing Then
  2135. objTarget.ClearKeyManagementServiceLookupDomain
  2136. QuitIfError()
  2137.  
  2138. LineOut GetResource("L_MsgKmsLookupDomainCleared")
  2139.  
  2140. If objTarget.KeyManagementServiceMachine <> "" Then
  2141. strKms = objTarget.KeyManagementServiceMachine
  2142. nPort = objTarget.KeyManagementServicePort
  2143. LineOut Replace(GetResource("L_MsgKmsUseMachineName"), _
  2144. "%KMS%", strKms & ":" & nPort)
  2145. End If
  2146.  
  2147. End If
  2148. End Sub
  2149.  
  2150. Private Sub SetHostCachingDisable(boolHostCaching)
  2151. Dim objService
  2152.  
  2153. On Error Resume Next
  2154.  
  2155. set objService = GetServiceObject("Version")
  2156. QuitIfError()
  2157.  
  2158. objService.DisableKeyManagementServiceHostCaching(boolHostCaching)
  2159. QuitIfError()
  2160.  
  2161. If boolHostCaching Then
  2162. LineOut GetResource("L_MsgKmsHostCachingDisabled")
  2163. Else
  2164. LineOut GetResource("L_MsgKmsHostCachingEnabled")
  2165. End If
  2166.  
  2167. End Sub
  2168.  
  2169. Private Sub SetActivationInterval(intInterval)
  2170. Dim objService, objProduct
  2171. Dim kmsFlag, strOutput
  2172.  
  2173. If (intInterval < 0) Then
  2174. LineOut GetResource("L_MsgInvalidDataError")
  2175. Exit Sub
  2176. End If
  2177.  
  2178. On Error Resume Next
  2179.  
  2180. set objService = GetServiceObject("Version")
  2181. QuitIfError()
  2182.  
  2183. For Each objProduct in GetProductCollection("ID, IsKeyManagementServiceMachine", PartialProductKeyNonNullWhereClause)
  2184. kmsFlag = objProduct.IsKeyManagementServiceMachine
  2185. If kmsFlag = 1 Then
  2186. objService.SetVLActivationInterval(intInterval)
  2187. QuitIfError()
  2188. strOutput = Replace(GetResource("L_MsgActivationSet"), "%ACTIVATION%", intInterval)
  2189. LineOut strOutput
  2190. LineOut GetResource("L_MsgWarningKmsReboot")
  2191.  
  2192. Exit For
  2193. End If
  2194. Next
  2195.  
  2196. If kmsFlag <> 1 Then
  2197. LineOut GetResource("L_MsgWarningActivation")
  2198. End If
  2199. End Sub
  2200.  
  2201. Private Sub SetRenewalInterval(intInterval)
  2202. Dim objService, objProduct
  2203. Dim kmsFlag, strOutput
  2204.  
  2205. If (intInterval < 0) Then
  2206. LineOut GetResource("L_MsgInvalidDataError")
  2207. Exit Sub
  2208. End If
  2209.  
  2210. On Error Resume Next
  2211.  
  2212. set objService = GetServiceObject("Version")
  2213. QuitIfError()
  2214.  
  2215. For Each objProduct in GetProductCollection("ID, IsKeyManagementServiceMachine", PartialProductKeyNonNullWhereClause)
  2216. kmsFlag = objProduct.IsKeyManagementServiceMachine
  2217. If kmsFlag Then
  2218. objService.SetVLRenewalInterval(intInterval)
  2219. QuitIfError()
  2220. strOutput = Replace(GetResource("L_MsgRenewalSet"), "%RENEWAL%", intInterval)
  2221. LineOut strOutput
  2222. LineOut GetResource("L_MsgWarningKmsReboot")
  2223.  
  2224. Exit For
  2225. End If
  2226. Next
  2227.  
  2228. If kmsFlag <> 1 Then
  2229. LineOut GetResource("L_MsgWarningRenewal")
  2230. End If
  2231. End Sub
  2232.  
  2233. Private Sub SetKmsListenPort(strPort)
  2234. Dim objService, objProduct
  2235. Dim kmsFlag, lRet, strOutput
  2236. Dim nPort
  2237.  
  2238. On Error Resume Next
  2239.  
  2240. set objService = GetServiceObject("Version")
  2241. QuitIfError()
  2242.  
  2243. For Each objProduct in GetProductCollection("ID, IsKeyManagementServiceMachine", PartialProductKeyNonNullWhereClause)
  2244. kmsFlag = objProduct.IsKeyManagementServiceMachine
  2245. If kmsFlag Then
  2246. nPort = CLng(strPort)
  2247. objService.SetKeyManagementServiceListeningPort(nPort)
  2248. QuitIfError()
  2249. strOutput = Replace(GetResource("L_MsgKmsPortSet"), "%PORT%", strPort)
  2250. LineOut strOutput
  2251. LineOut GetResource("L_MsgWarningKmsReboot")
  2252.  
  2253. Exit For
  2254. End If
  2255. Next
  2256.  
  2257. If kmsFlag <> 1 Then
  2258. LineOut GetResource("L_MsgWarningKmsPort")
  2259. End If
  2260. End Sub
  2261.  
  2262. Private Sub SetDnsPublishingDisabled(bool)
  2263. Dim objService, objProduct
  2264. Dim kmsFlag, lRet, dwValue
  2265.  
  2266. On Error Resume Next
  2267.  
  2268. set objService = GetServiceObject("Version")
  2269. QuitIfError()
  2270.  
  2271. For Each objProduct in GetProductCollection("ID, IsKeyManagementServiceMachine", PartialProductKeyNonNullWhereClause)
  2272. kmsFlag = objProduct.IsKeyManagementServiceMachine
  2273. If kmsFlag Then
  2274. objService.DisableKeyManagementServiceDnsPublishing(bool)
  2275. QuitIfError()
  2276.  
  2277. If bool Then
  2278. LineOut GetResource("L_MsgKmsDnsPublishingDisabled")
  2279. Else
  2280. LineOut GetResource("L_MsgKmsDnsPublishingEnabled")
  2281. End If
  2282. LineOut GetResource("L_MsgWarningKmsReboot")
  2283.  
  2284. Exit For
  2285. End If
  2286. Next
  2287.  
  2288. If kmsFlag <> 1 Then
  2289. LineOut GetResource("L_MsgKmsDnsPublishingWarning")
  2290. End If
  2291. End Sub
  2292.  
  2293. Private Sub SetKmsLowPriority(bool)
  2294. Dim objService, objProduct
  2295. Dim kmsFlag, lRet, dwValue
  2296.  
  2297. On Error Resume Next
  2298.  
  2299. set objService = GetServiceObject("Version")
  2300. QuitIfError()
  2301.  
  2302. For Each objProduct in GetProductCollection("ID, IsKeyManagementServiceMachine", PartialProductKeyNonNullWhereClause)
  2303. kmsFlag = objProduct.IsKeyManagementServiceMachine
  2304. If kmsFlag Then
  2305. objService.EnableKeyManagementServiceLowPriority(bool)
  2306. QuitIfError()
  2307.  
  2308. If bool Then
  2309. LineOut GetResource("L_MsgKmsPriSetToLow")
  2310. Else
  2311. LineOut GetResource("L_MsgKmsPriSetToNormal")
  2312. End If
  2313. LineOut GetResource("L_MsgWarningKmsReboot")
  2314. End If
  2315.  
  2316. Exit For
  2317. Next
  2318.  
  2319.  
  2320. If kmsFlag <> 1 Then
  2321. LineOut GetResource("L_MsgWarningKmsPri")
  2322. End If
  2323. End Sub
  2324.  
  2325. Private Sub SetVLActivationType(intType, strActivationID)
  2326. Dim objTarget
  2327.  
  2328. If IsNull(intType) Then
  2329. intType = 0
  2330. End If
  2331.  
  2332. If (intType < 0) Or (intType > 3) Then
  2333. LineOut GetResource("L_MsgInvalidDataError")
  2334. Exit Sub
  2335. End If
  2336.  
  2337. Set objTarget = GetKmsClientObjectByActivationID(strActivationID)
  2338.  
  2339. On Error Resume Next
  2340.  
  2341. If Not objTarget is Nothing Then
  2342. If (intType <> 0) Then
  2343. objTarget.SetVLActivationTypeEnabled(intType)
  2344. QuitIfError()
  2345. Else
  2346. objTarget.ClearVLActivationTypeEnabled()
  2347. QuitIfError()
  2348. End If
  2349.  
  2350. LineOut GetResource("L_MsgVLActivationTypeSet")
  2351. End If
  2352. End Sub
  2353.  
  2354. ''
  2355. '' Token-based Activation Commands
  2356. ''
  2357.  
  2358. Private Function IsTokenActivated(objProduct)
  2359.  
  2360. Dim nILVID
  2361.  
  2362. On Error Resume Next
  2363.  
  2364. nILVID = objProduct.TokenActivationILVID
  2365.  
  2366. IsTokenActivated = ((Err.Number = 0) And (nILVID <> &HFFFFFFFF))
  2367.  
  2368. End Function
  2369.  
  2370.  
  2371. Private Sub TkaListILs
  2372. Dim objLicense
  2373. Dim strHeader
  2374. Dim strError
  2375. Dim strGuids
  2376. Dim arrGuids
  2377. Dim nListed
  2378.  
  2379. Dim objWmiDate
  2380.  
  2381. LineOut GetResource("L_MsgTkaLicenses")
  2382. LineOut ""
  2383.  
  2384. Set objWmiDate = CreateObject("WBemScripting.SWbemDateTime")
  2385.  
  2386. nListed = 0
  2387. For Each objLicense in g_objWMIService.InstancesOf(TkaLicenseClass)
  2388.  
  2389. strHeader = GetResource("L_MsgTkaLicenseHeader")
  2390. strHeader = Replace(strHeader, "%ILID%" , objLicense.ILID )
  2391. strHeader = Replace(strHeader, "%ILVID%", objLicense.ILVID)
  2392. LineOut strHeader
  2393.  
  2394. LineOut " " & Replace(GetResource("L_MsgTkaLicenseILID"), "%ILID%", objLicense.ILID)
  2395. LineOut " " & Replace(GetResource("L_MsgTkaLicenseILVID"), "%ILVID%", objLicense.ILVID)
  2396.  
  2397. If Not IsNull(objLicense.ExpirationDate) Then
  2398.  
  2399. objWmiDate.Value = objLicense.ExpirationDate
  2400.  
  2401. If (objWmiDate.GetFileTime(false) <> 0) Then
  2402. LineOut " " & Replace(GetResource("L_MsgTkaLicenseExpiration"), "%TODATE%", objWmiDate.GetVarDate)
  2403. End If
  2404.  
  2405. End If
  2406.  
  2407. If Not IsNull(objLicense.AdditionalInfo) Then
  2408. LineOut " " & Replace(GetResource("L_MsgTkaLicenseAdditionalInfo"), "%MOREINFO%", objLicense.AdditionalInfo)
  2409. End If
  2410.  
  2411. If Not IsNull(objLicense.AuthorizationStatus) And _
  2412. objLicense.AuthorizationStatus <> 0 _
  2413. Then
  2414. strError = CStr(Hex(objLicense.AuthorizationStatus))
  2415. LineOut " " & Replace(GetResource("L_MsgTkaLicenseAuthZStatus"), "%ERRCODE%", strError)
  2416. Else
  2417. LineOut " " & Replace(GetResource("L_MsgTkaLicenseDescr"), "%DESC%", objLicense.Description)
  2418. End If
  2419.  
  2420. LineOut ""
  2421. nListed = nListed + 1
  2422. Next
  2423.  
  2424. if 0 = nListed Then
  2425. LineOut GetResource("L_MsgTkaLicenseNone")
  2426. End If
  2427. End Sub
  2428.  
  2429.  
  2430. Private Sub TkaRemoveIL(strILID, strILVID)
  2431. Dim objLicense
  2432. Dim strMsg
  2433. Dim nRemoved
  2434.  
  2435. Dim nILVID
  2436.  
  2437. On Error Resume Next
  2438. nILVID = CInt(strILVID)
  2439. QuitIfError()
  2440.  
  2441. LineOut GetResource("L_MsgTkaRemoving")
  2442. LineOut ""
  2443.  
  2444. nRemoved = 0
  2445. For Each objLicense in g_objWMIService.InstancesOf(TkaLicenseClass)
  2446. If strILID = objLicense.ILID And nILVID = objLicense.ILVID Then
  2447. strMsg = GetResource("L_MsgTkaRemovedItem")
  2448. strMsg = Replace(strMsg, "%SLID%", objLicense.ID)
  2449.  
  2450. On Error Resume Next
  2451. objLicense.Uninstall
  2452. QuitIfError()
  2453. LineOut strMsg
  2454. nRemoved = nRemoved + 1
  2455. End If
  2456. Next
  2457.  
  2458. If nRemoved = 0 Then
  2459. LineOut GetResource("L_MsgTkaRemovedNone")
  2460. End If
  2461. End Sub
  2462.  
  2463.  
  2464. Private Sub TkaListCerts
  2465. Dim objProduct
  2466. Dim objSigner
  2467. Dim iRet
  2468. Dim arrGrants()
  2469. Dim arrThumbprints
  2470. Dim strThumbprint
  2471.  
  2472. On Error Resume Next
  2473.  
  2474. Set objSigner = TkaGetSigner()
  2475. Set objProduct = TkaGetProduct()
  2476.  
  2477. iRet = objProduct.GetTokenActivationGrants(arrGrants)
  2478. QuitIfError()
  2479.  
  2480. arrThumbprints = objSigner.GetCertificateThumbprints(arrGrants)
  2481. QuitIfError()
  2482.  
  2483. For Each strThumbprint in arrThumbprints
  2484. TkaPrintCertificate strThumbprint
  2485. Next
  2486. End Sub
  2487.  
  2488.  
  2489. Private Sub TkaActivate(strThumbprint, strPin)
  2490. Dim objService
  2491. Dim objProduct
  2492. Dim objSigner
  2493. Dim iRet
  2494.  
  2495. Dim strChallenge
  2496.  
  2497. Dim strAuthInfo1
  2498. Dim strAuthInfo2
  2499.  
  2500. Set objSigner = TkaGetSigner()
  2501. Set objProduct = TkaGetProduct()
  2502. Set objService = TkaGetService()
  2503.  
  2504. DisplayActivatingSku objProduct
  2505.  
  2506. On Error Resume Next
  2507.  
  2508. iRet = objProduct.GenerateTokenActivationChallenge(strChallenge)
  2509. QuitIfError()
  2510.  
  2511. strAuthInfo1 = objSigner.Sign(strChallenge, strThumbprint, strPin, strAuthInfo2)
  2512. QuitIfError()
  2513.  
  2514. iRet = objProduct.DepositTokenActivationResponse(strChallenge, strAuthInfo1, strAuthInfo2)
  2515. QuitIfError()
  2516.  
  2517. objService.RefreshLicenseStatus()
  2518. Err.Number = 0
  2519.  
  2520. objProduct.refresh_
  2521. DisplayActivatedStatus objProduct
  2522. QuitIfError()
  2523.  
  2524. End Sub
  2525.  
  2526.  
  2527. Private Function TkaGetService()
  2528.  
  2529. Set TkaGetService = GetServiceObject("Version")
  2530.  
  2531. End Function
  2532.  
  2533.  
  2534. Private Function TkaGetProduct()
  2535.  
  2536. Dim objWinProductsWithPKeyInstalled
  2537. Dim objProduct
  2538.  
  2539. On Error Resume Next
  2540.  
  2541. Set TkaGetProduct = Nothing
  2542.  
  2543. Set TkaGetProduct = GetProductObject( _
  2544. "ID, Name, ApplicationId, PartialProductKey, Description, LicenseIsAddon ", _
  2545. "ApplicationId = '" & WindowsAppId & "' " &_
  2546. "AND PartialProductKey <> NULL " & _
  2547. "AND LicenseIsAddon = FALSE" _
  2548. )
  2549. QuitIfError()
  2550.  
  2551. End Function
  2552.  
  2553. Private Function TkaGetSigner()
  2554.  
  2555. On Error Resume Next
  2556. Set TkaGetSigner = WScript.CreateObject("SPPWMI.SppWmiTokenActivationSigner")
  2557. QuitIfError()
  2558.  
  2559. End Function
  2560.  
  2561. Private Sub TkaPrintCertificate(strThumbprint)
  2562. Dim arrParams
  2563.  
  2564. arrParams = Split(strThumbprint, "|")
  2565.  
  2566. LineOut ""
  2567. LineOut Replace(GetResource("L_MsgTkaCertThumbprint"), "%THUMBPRINT%", arrParams(0))
  2568. LineOut Replace(GetResource("L_MsgTkaCertSubject" ), "%SUBJECT%" , arrParams(1))
  2569. LineOut Replace(GetResource("L_MsgTkaCertIssuer" ), "%ISSUER%" , arrParams(2))
  2570. LineOut Replace(GetResource("L_MsgTkaCertValidFrom" ), "%FROMDATE%" , FormatDateTime(CDate(arrParams(3)), vbShortDate))
  2571. LineOut Replace(GetResource("L_MsgTkaCertValidTo" ), "%TODATE%" , FormatDateTime(CDate(arrParams(4)), vbShortDate))
  2572. End Sub
  2573.  
  2574. ''
  2575. '' Active Directory Activation Commands
  2576. ''
  2577.  
  2578. Private Function IsADActivated(objProduct)
  2579. On Error Resume Next
  2580.  
  2581. If (objProduct.VLActivationType = 1) Then
  2582. IsADActivated = True
  2583. Else
  2584. IsADActivated = False
  2585. End If
  2586.  
  2587. End Function
  2588.  
  2589. Private Sub ADActivateOnline(strProductKey, strActivationObjectName)
  2590. Dim objService
  2591.  
  2592. FailRemoteExec()
  2593.  
  2594. On Error Resume Next
  2595.  
  2596. set objService = GetServiceObject("Version")
  2597. QuitIfError()
  2598.  
  2599. objService.DoActiveDirectoryOnlineActivation strProductKey, strActivationObjectName
  2600. QuitIfError()
  2601.  
  2602. LineOut GetResource("L_MsgActivated")
  2603.  
  2604. End Sub
  2605.  
  2606. Private Sub ADGetIID(strProductKey)
  2607. Dim objService
  2608. Dim strIID
  2609.  
  2610. FailRemoteExec()
  2611.  
  2612. On Error Resume Next
  2613.  
  2614. set objService = GetServiceObject("Version")
  2615.  
  2616. objService.GenerateActiveDirectoryOfflineActivationId strProductKey, strIID
  2617. QuitIfError()
  2618.  
  2619. LineOut GetResource("L_MsgInstallationID") & strIID
  2620. LineOut ""
  2621. LineOut GetResource("L_MsgPhoneNumbers")
  2622.  
  2623. End Sub
  2624.  
  2625. Private Sub ADActivatePhone(strProductKey, strCID, strActivationObjectName)
  2626. Dim objService
  2627. Dim strIID
  2628.  
  2629. FailRemoteExec()
  2630.  
  2631. On Error Resume Next
  2632.  
  2633. set objService = GetServiceObject("Version")
  2634.  
  2635. objService.DepositActiveDirectoryOfflineActivationConfirmation strProductKey, strCID, strActivationObjectName
  2636. QuitIfError()
  2637.  
  2638. LineOut GetResource("L_MsgActivated")
  2639.  
  2640. End Sub
  2641.  
  2642. Private Sub ADListActivationObjects()
  2643. Dim machineDomain
  2644. Dim namespace
  2645. Dim rootDSE, configurationNC
  2646. Dim container, child
  2647. Dim found
  2648.  
  2649. FailRemoteExec()
  2650.  
  2651. On Error Resume Next
  2652.  
  2653. '
  2654. ' Fetch computer's domain name. This must be used while querying for
  2655. ' Activation Objects to ensure we do not query them from current user's
  2656. ' domain (which may be in a different forest than computer's domain).
  2657. '
  2658. machineDomain = GetMachineDomain()
  2659. QuitIfError()
  2660.  
  2661. set namespace = GetObject(ADLdapProvider)
  2662. QuitIfError()
  2663.  
  2664. set rootDSE = namespace.OpenDSObject(ADLdapProviderPrefix & machineDomain & ADRootDSE, vbNullString, vbNullString, ADS_READONLY_SERVER)
  2665. QuitIfError()
  2666.  
  2667. configurationNC = rootDSE.Get(ADConfigurationNC)
  2668. QuitIfError()
  2669.  
  2670. set container = namespace.OpenDSObject(ADLdapProviderPrefix & machineDomain & ADActObjContainer & configurationNC, vbNullString, vbNullString, ADS_READONLY_SERVER)
  2671. If Err.Number = HR_ERROR_DS_NO_SUCH_OBJECT Then
  2672. LineOut GetResource("L_MsgADSchemaNotSupported")
  2673. Exit Sub
  2674. End If
  2675. QuitIfError()
  2676.  
  2677. LineOut GetResource("L_MsgActObjAvailable")
  2678.  
  2679. found = False
  2680.  
  2681. For Each child in container
  2682. If child.Class = ADActObjClass Then
  2683. found = True
  2684. child.GetInfoEx Array(ADActObjDisplayName, ADActObjAttribDN, ADActObjAttribSkuId, ADActObjAttribPid), 0
  2685. LineOut " " & GetResource("L_MsgADInfoAOName") & child.Get(ADActObjDisplayName)
  2686. LineOut " " & " " & GetResource("L_MsgActID") & GuidToString(child.Get(ADActObjAttribSkuId))
  2687. LineOut " " & " " & GetResource("L_MsgPartialPKey") & child.Get(ADActObjAttribPartialPkey)
  2688. LineOut " " & " " & GetResource("L_MsgADInfoExtendedPid") & child.Get(ADActObjAttribPid)
  2689. LineOut " " & " " & GetResource("L_MsgADInfoAODN") & child.Get(ADActObjAttribDN)
  2690. LineOut ""
  2691. End If
  2692. Next
  2693.  
  2694. If (found = False) Then
  2695. LineOut " " & GetResource("L_MsgActObjNoneFound")
  2696. End If
  2697.  
  2698. End Sub
  2699.  
  2700. Private Sub ADDeleteActivationObjects(strName)
  2701. Dim machineDomain
  2702. Dim namespace
  2703. Dim rootDSE, configurationNC
  2704. Dim container, strDN
  2705. Dim object, parent
  2706.  
  2707. FailRemoteExec()
  2708.  
  2709. On Error Resume Next
  2710.  
  2711. machineDomain = GetMachineDomain()
  2712. QuitIfError()
  2713.  
  2714. set namespace = GetObject(ADLdapProvider)
  2715. QuitIfError()
  2716.  
  2717. set rootDSE = GetObject(ADLdapProviderPrefix & machineDomain & ADRootDSE)
  2718. QuitIfError()
  2719.  
  2720. configurationNC = rootDSE.Get(ADConfigurationNC)
  2721. QuitIfError()
  2722.  
  2723. '
  2724. ' Check if AD schema supports Activation Objects containers
  2725. '
  2726. set container = namespace.OpenDSObject(ADLdapProviderPrefix & machineDomain & ADActObjContainer & configurationNC, vbNullString, vbNullString, ADS_READONLY_SERVER)
  2727. If Err.Number = HR_ERROR_DS_NO_SUCH_OBJECT Then
  2728. LineOut GetResource("L_MsgADSchemaNotSupported")
  2729. Exit Sub
  2730. End If
  2731. QuitIfError()
  2732.  
  2733. If InStr(1, strName, ",cn=", vbTextCompare) > 0 Then
  2734. strDN = strName
  2735. Else
  2736. '
  2737. ' RDN was provided. Construct a full DN from it.
  2738. '
  2739.  
  2740. ' Use computer's domain name to construct the Activation Object DN.
  2741. If 1 = InStr(1, strName, "cn=", vbTextCompare) Then
  2742. strDN = strName & "," & ADActObjContainer & configurationNC
  2743. Else
  2744. strDN = "CN=" & strName & "," & ADActObjContainer & configurationNC
  2745. End If
  2746.  
  2747. LineOut " " & GetResource("L_MsgADInfoAODN") & strDN
  2748. LineOut ""
  2749. End If
  2750.  
  2751. set object = GetObject(ADLdapProviderPrefix & strDN)
  2752. QuitIfError()
  2753.  
  2754. set parent = GetObject(object.Parent)
  2755. QuitIfError()
  2756.  
  2757. If (object.Class = ADActObjClass) Then
  2758. parent.Delete object.Class, object.Name
  2759. QuitIfError()
  2760. End If
  2761.  
  2762. LineOut GetResource("L_MsgSucess")
  2763.  
  2764. End Sub
  2765.  
  2766. ' other generic options/helpers
  2767.  
  2768. Private Sub LineOut(str)
  2769. g_EchoString = g_EchoString & str & vbNewLine
  2770. End Sub
  2771.  
  2772. Private Sub LineFlush(str)
  2773. WScript.Echo g_EchoString & str
  2774. g_EchoString = ""
  2775. End Sub
  2776.  
  2777. Private Sub ExitScript(retval)
  2778. if (g_EchoString <> "") Then
  2779. WScript.Echo g_EchoString
  2780. End If
  2781. WScript.Quit retval
  2782. End Sub
  2783.  
  2784. Function GetMachineDomain()
  2785. Dim adSystemInfo
  2786. Dim machineDomain
  2787.  
  2788. set adSystemInfo = CreateObject("ADSystemInfo")
  2789. QuitIfError()
  2790.  
  2791. machineDomain = adSystemInfo.DomainDNSName & "/"
  2792. QuitIfError()
  2793.  
  2794. GetMachineDomain = machineDomain
  2795. End Function
  2796.  
  2797. Function HexByte(b)
  2798. HexByte = Right("0" & Hex(b), 2)
  2799. End Function
  2800.  
  2801. Function GuidToString(ByteArray)
  2802. Dim Binary, S
  2803. Binary = CStr(ByteArray)
  2804. S = "{"
  2805. S = S & HexByte(AscB(MidB(Binary, 4, 1)))
  2806. S = S & HexByte(AscB(MidB(Binary, 3, 1)))
  2807. S = S & HexByte(AscB(MidB(Binary, 2, 1)))
  2808. S = S & HexByte(AscB(MidB(Binary, 1, 1)))
  2809. S = S & "-"
  2810. S = S & HexByte(AscB(MidB(Binary, 6, 1)))
  2811. S = S & HexByte(AscB(MidB(Binary, 5, 1)))
  2812. S = S & "-"
  2813. S = S & HexByte(AscB(MidB(Binary, 8, 1)))
  2814. S = S & HexByte(AscB(MidB(Binary, 7, 1)))
  2815. S = S & "-"
  2816. S = S & HexByte(AscB(MidB(Binary, 9, 1)))
  2817. S = S & HexByte(AscB(MidB(Binary, 10, 1)))
  2818. S = S & "-"
  2819. S = S & HexByte(AscB(MidB(Binary, 11, 1)))
  2820. S = S & HexByte(AscB(MidB(Binary, 12, 1)))
  2821. S = S & HexByte(AscB(MidB(Binary, 13, 1)))
  2822. S = S & HexByte(AscB(MidB(Binary, 14, 1)))
  2823. S = S & HexByte(AscB(MidB(Binary, 15, 1)))
  2824. S = S & HexByte(AscB(MidB(Binary, 16, 1)))
  2825. S = S & "}"
  2826. GuidToString = S
  2827. End Function
  2828.  
  2829. Private Sub InstallLicense(licFile)
  2830. Dim objService
  2831. Dim LicenseData
  2832. Dim strOutput
  2833.  
  2834. On Error Resume Next
  2835. LicenseData = ReadAllTextFile(licFile)
  2836. QuitIfError()
  2837. set objService = GetServiceObject("Version")
  2838. QuitIfError()
  2839.  
  2840. objService.InstallLicense(LicenseData)
  2841. QuitIfError()
  2842.  
  2843. strOutput = Replace(GetResource("L_MsgLicenseFile"), "%LICENSEFILE%", licFile)
  2844. LineOut strOutput
  2845. LineOut ""
  2846. End Sub
  2847.  
  2848.  
  2849. ' Returns the encoding for a givven file.
  2850. ' Possible return values: ascii, unicode, unicodeFFFE (big-endian), utf-8
  2851. Function GetFileEncoding(strFileName)
  2852. Dim strData
  2853. Dim strEncoding
  2854. Dim oStream
  2855.  
  2856. Set oStream = CreateObject("ADODB.Stream")
  2857.  
  2858. oStream.Type = 1 'adTypeBinary
  2859. oStream.Open
  2860. oStream.LoadFromFile(strFileName)
  2861.  
  2862. ' Default encoding is ascii
  2863. strEncoding = "ascii"
  2864.  
  2865. strData = BinaryToString(oStream.Read(2))
  2866.  
  2867. ' Check for little endian (x86) unicode preamble
  2868. If (Len(strData) = 2) and strData = (Chr(255) + Chr(254)) Then
  2869. strEncoding = "unicode"
  2870. Else
  2871. oStream.Position = 0
  2872. strData = BinaryToString(oStream.Read(3))
  2873.  
  2874. ' Check for utf-8 preamble
  2875. If (Len(strData) >= 3) and strData = (Chr(239) + Chr(187) + Chr(191)) Then
  2876. strEncoding = "utf-8"
  2877. End If
  2878. End If
  2879.  
  2880. oStream.Close
  2881.  
  2882. GetFileEncoding = strEncoding
  2883. End Function
  2884.  
  2885. ' Converts binary data (VT_UI1 | VT_ARRAY) to a string (BSTR)
  2886. Function BinaryToString(dataBinary)
  2887. Dim i
  2888. Dim str
  2889.  
  2890. For i = 1 To LenB(dataBinary)
  2891. str = str & Chr(AscB(MidB(dataBinary, i, 1)))
  2892. Next
  2893.  
  2894. BinaryToString = str
  2895. End Function
  2896.  
  2897. ' Returns string containing the whole text file data.
  2898. ' Supports ascii, unicode (little-endian) and utf-8 encoding.
  2899. Function ReadAllTextFile(strFileName)
  2900. Dim strData
  2901. Dim oStream
  2902.  
  2903. Set oStream = CreateObject("ADODB.Stream")
  2904.  
  2905. oStream.Type = 2 'adTypeText
  2906. oStream.Open
  2907. oStream.Charset = GetFileEncoding(strFileName)
  2908. oStream.LoadFromFile(strFileName)
  2909.  
  2910. strData = oStream.ReadText(-1) 'adReadAll
  2911.  
  2912. oStream.Close
  2913.  
  2914. ReadAllTextFile = strData
  2915. End Function
  2916.  
  2917. Private Function HandleOptionParam(cParam, mustProvide, opt, param)
  2918. Dim strOutput
  2919.  
  2920. HandleOptionParam = True
  2921. If WScript.Arguments.Count <= cParam Then
  2922. HandleOptionParam = False
  2923. If mustProvide Then
  2924. LineOut ""
  2925. strOutput = Replace(GetResource("L_MsgErrorText_9"), "%OPTION%", opt)
  2926. strOutput = Replace(strOutput, "%PARAM%", param)
  2927. LineOut strOutput
  2928. Call DisplayUsage()
  2929. End If
  2930. End If
  2931. End Function
  2932.  
  2933. '
  2934. ' A Copy of Err from the point of origin
  2935. '
  2936. Class CErr
  2937. Public Number
  2938. Public Description
  2939. Public Source
  2940.  
  2941. Private Sub Class_Initialize
  2942. Number = Err.Number
  2943. Description = Err.Description
  2944. Source = Err.Source
  2945. End Sub
  2946. End Class
  2947.  
  2948. Function NewCErr(number, source, description)
  2949. Dim objError
  2950.  
  2951. Set objError = new CErr
  2952. objError.Number = CLng(number)
  2953. objError.Source = source
  2954. objError.Description = description
  2955.  
  2956. Set NewCErr = objError
  2957. End Function
  2958.  
  2959. Private Sub ShowError(ByVal strMessage, ByVal objErr)
  2960. Dim strDescription
  2961. Dim strNumber
  2962.  
  2963. ' Convert error number to text. Use hexadecimal format for negative values such as HRESULT errors.
  2964. If objErr.Number >= 0 Then
  2965. strNumber = CStr(objErr.Number)
  2966. Else
  2967. strNumber = "0x" & Hex(objErr.Number)
  2968. End If
  2969.  
  2970. strDescription = GetResource("L_MsgError_" & Hex(objErr.Number))
  2971.  
  2972. If strDescription = "" Then
  2973. If objErr.Description = "" Then
  2974. strDescription = Replace(GetResource("L_MsgErrorText_6"), "0x%ERRCODE%", strNumber)
  2975. ElseIf objErr.Source = "" Then
  2976. strDescription = objErr.Description
  2977. Else
  2978. strDescription = objErr.Description & " (" & objErr.Source & ")"
  2979. End If
  2980. End If
  2981.  
  2982. If 0 = InStr(strMessage, "0x%ERRCODE%") Then
  2983. strMessage = strMessage & "0x%ERRCODE%"
  2984. End If
  2985.  
  2986. If 0 = InStr(strMessage, "%ERRTEXT%") Then
  2987. strMessage = strMessage & " %ERRTEXT%"
  2988. End If
  2989.  
  2990. strMessage = Replace(strMessage, "%COMPUTERNAME%", g_strComputer)
  2991. strMessage = Replace(strMessage, "0x%ERRCODE%", strNumber)
  2992. strMessage = Replace(strMessage, "%ERRTEXT%", strDescription)
  2993.  
  2994. LineOut strMessage
  2995. End Sub
  2996.  
  2997. Private Sub QuitIfError()
  2998. QuitIfError2 "L_MsgErrorText_8"
  2999. End Sub
  3000.  
  3001. Private Sub QuitIfError2(strMessage)
  3002. Dim objErr
  3003.  
  3004. If Err.Number <> 0 Then
  3005. Set objErr = new CErr
  3006.  
  3007. ShowError GetResource(strMessage), objErr
  3008. ExitScript objErr.Number
  3009. End If
  3010. End Sub
  3011.  
  3012. Private Sub QuitWithError(errNum)
  3013. ShowError GetResource("L_MsgErrorText_8"), NewCErr(errNum, Empty, Empty)
  3014. ExitScript errNum
  3015. End Sub
  3016.  
  3017.  
  3018. Private Sub Connect
  3019. Dim objLocator, strOutput
  3020. Dim objServer, objService
  3021. Dim strErr, strVersion
  3022.  
  3023. On Error Resume Next
  3024.  
  3025. 'If this is the local computer, set everything and return immediately
  3026. If g_strComputer = "." Then
  3027. Set g_objWMIService = GetObject("winmgmts:\\" & g_strComputer & "\root\cimv2")
  3028. QuitIfError2("L_MsgErrorLocalWMI")
  3029.  
  3030. Set g_objRegistry = GetObject("winmgmts:\\" & g_strComputer & "\root\default:StdRegProv")
  3031. QuitIfError2("L_MsgErrorLocalRegistry")
  3032.  
  3033. Exit Sub
  3034. End If
  3035.  
  3036. 'Otherwise, establish the remote object connections
  3037.  
  3038. ' Create Locator object to connect to remote CIM object manager
  3039. Set objLocator = CreateObject("WbemScripting.SWbemLocator")
  3040. QuitIfError2("L_MsgErrorWMI")
  3041.  
  3042. ' Connect to the namespace which is either local or remote
  3043. Set g_objWMIService = objLocator.ConnectServer (g_strComputer, "\root\cimv2", g_strUserName, g_strPassword)
  3044. QuitIfError2("L_MsgErrorConnection")
  3045.  
  3046. g_IsRemoteComputer = True
  3047.  
  3048. g_objWMIService.Security_.impersonationlevel = wbemImpersonationLevelImpersonate
  3049. QuitIfError2("L_MsgErrorImpersonation")
  3050.  
  3051. g_objWMIService.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
  3052. QuitIfError2("L_MsgErrorAuthenticationLevel")
  3053.  
  3054. ' Get the SPP service version on the remote machine
  3055. set objService = GetServiceObject("Version")
  3056. strVersion = objService.Version
  3057.  
  3058. ' The Windows 8 version of SLMgr.vbs does not support remote connections to Vista/WS08 and Windows 7/WS08R2 machines
  3059. if (Not IsNull(strVersion)) Then
  3060. strVersion = Left(strVersion, 3)
  3061. If (strVersion = "6.0") Or (strVersion = "6.1") Then
  3062. LineOut GetResource("L_MsgRemoteWmiVersionMismatch")
  3063. ExitScript 1
  3064. End If
  3065. End If
  3066.  
  3067. Set objServer = objLocator.ConnectServer(g_strComputer, "\root\default:StdRegProv", g_strUserName, g_strPassword)
  3068. QuitIfError2("L_MsgErrorConnectionRegistry")
  3069.  
  3070. objServer.Security_.ImpersonationLevel = 3
  3071. Set g_objRegistry = objServer.Get("StdRegProv")
  3072. QuitIfError2("L_MsgErrorConnectionRegistry")
  3073. End Sub
  3074.  
  3075. Function GetServiceObject(strQuery)
  3076. Dim objService
  3077. Dim colServices
  3078.  
  3079. On Error Resume Next
  3080.  
  3081. Set colServices = g_objWMIService.ExecQuery("SELECT " & strQuery & " FROM " & ServiceClass)
  3082. QuitIfError()
  3083.  
  3084. For each objService in colServices
  3085. QuitIfError()
  3086. Exit For
  3087. Next
  3088.  
  3089. QuitIfError()
  3090.  
  3091. set GetServiceObject = objService
  3092. End Function
  3093.  
  3094. Function GetProductCollection(strSelect, strWhere)
  3095. Dim colProducts
  3096. Dim objProduct
  3097.  
  3098. On Error Resume Next
  3099.  
  3100. If strWhere = EmptyWhereClause Then
  3101. Set colProducts = g_objWMIService.ExecQuery("SELECT " & strSelect & " FROM " & ProductClass)
  3102. QuitIfError()
  3103. Else
  3104. Set colProducts = g_objWMIService.ExecQuery("SELECT " & strSelect & " FROM " & ProductClass & " WHERE " & strWhere)
  3105. QuitIfError()
  3106. End If
  3107.  
  3108. For each objProduct in colProducts
  3109. Next
  3110.  
  3111. QuitIfError()
  3112.  
  3113. set GetProductCollection = colProducts
  3114. End Function
  3115.  
  3116. Function GetProductObject(strSelect, strWhere)
  3117. Dim objProduct
  3118. Dim colProducts
  3119. Dim iProductsFound
  3120.  
  3121. On Error Resume Next
  3122.  
  3123. iProductsFound = 0
  3124. Set colProducts = GetProductCollection(strSelect, strWhere)
  3125. For each objProduct in colProducts
  3126. QuitIfError()
  3127. iProductsFound = iProductsFound + 1
  3128. Next
  3129.  
  3130. 'There should be exactly one product returned by the query. If there are none
  3131. 'assume the product key and/or licenses are missing. If there are more than one
  3132. 'then fail with invalid arguments.
  3133. If iProductsFound = 0 Then
  3134. LineOut GetResource("L_MsgErrorPKey")
  3135. Err.Number = HR_SL_E_PKEY_NOT_INSTALLED
  3136. ElseIf iProductsFound <> 1 Then
  3137. Err.Number = HR_INVALID_ARG
  3138. End If
  3139. QuitIfError()
  3140.  
  3141. 'Return the first (and only) element in the collection
  3142. For each objProduct in colProducts
  3143. QuitIfError()
  3144. Exit For
  3145. Next
  3146.  
  3147. set GetProductObject = objProduct
  3148. End Function
  3149.  
  3150. Private Function IsKmsClient(strDescription)
  3151. If InStr(strDescription, "VOLUME_KMSCLIENT") > 0 Then
  3152. IsKmsClient = True
  3153. Else
  3154. IsKmsClient = False
  3155. End If
  3156. End Function
  3157.  
  3158. Private Function IsTkaClient(strDescription)
  3159. IsTkaClient = IsKmsClient(strDescription)
  3160. End Function
  3161.  
  3162. Private Function IsKmsServer(strDescription)
  3163. If IsKmsClient(strDescription) Then
  3164. IsKmsServer = False
  3165. Else
  3166. If InStr(strDescription, "VOLUME_KMS") > 0 Then
  3167. IsKmsServer = True
  3168. Else
  3169. IsKmsServer = False
  3170. End If
  3171. End If
  3172. End Function
  3173.  
  3174. Private Function IsTBL(strDescription)
  3175. If InStr(strDescription, "TIMEBASED_") > 0 Then
  3176. IsTBL = True
  3177. Else
  3178. IsTBL = False
  3179. End If
  3180. End Function
  3181.  
  3182. Private Function IsAVMA(strDescription)
  3183. If InStr(strDescription, "VIRTUAL_MACHINE_ACTIVATION") > 0 Then
  3184. IsAVMA = True
  3185. Else
  3186. IsAVMA = False
  3187. End If
  3188. End Function
  3189.  
  3190. Private Function IsMAK(strDescription)
  3191. If InStr(strDescription, "MAK") > 0 Then
  3192. IsMAK = True
  3193. Else
  3194. IsMAK = False
  3195. End If
  3196. End Function
  3197.  
  3198. Private Sub FailRemoteExec()
  3199. if (g_IsRemoteComputer = True) Then
  3200. Lineout GetResource("L_MsgRemoteExecNotSupported")
  3201. ExitScript 1
  3202. End If
  3203. End Sub
  3204.  
  3205. 'Returns 0 if this is not the primary SKU, 1 if it is, and 2 if we aren't certain (older clients)
  3206. Function GetIsPrimaryWindowsSKU(objProduct)
  3207. Dim iPrimarySku
  3208. Dim bIsAddOn
  3209.  
  3210. 'Assume this is not the primary SKU
  3211. iPrimarySku = 0
  3212. 'Verify the license is for Windows, that it has a partial key, and that
  3213. If (LCase(objProduct.ApplicationId) = WindowsAppId And objProduct.PartialProductKey <> "") Then
  3214. 'If we can get verify the AddOn property then we can be certain
  3215. On Error Resume Next
  3216. bIsAddOn = objProduct.LicenseIsAddon
  3217. If Err.Number = 0 Then
  3218. If bIsAddOn = true Then
  3219. iPrimarySku = 0
  3220. Else
  3221. iPrimarySku = 1
  3222. End If
  3223. Else
  3224. 'If we can not get the AddOn property then we assume this is a previous version
  3225. 'and we return a value of Uncertain, unless we can prove otherwise
  3226. If (IsKmsClient(objProduct.Description) Or IsKmsServer(objProduct.Description)) Then
  3227. 'If the description is KMS related, we can be certain that this is a primary SKU
  3228. iPrimarySku = 1
  3229. Else
  3230. 'Indeterminate since the property was missing and we can't verify KMS
  3231. iPrimarySku = 2
  3232. End If
  3233. End If
  3234. End If
  3235. GetIsPrimaryWindowsSKU = iPrimarySku
  3236. End Function
  3237.  
  3238. Private Function WasPrimaryKeyFound(strPrimarySkuType)
  3239. If (IsKmsServer(strPrimarySkuType) Or IsKmsClient(strPrimarySkuType) Or (InStr(strPrimarySkuType, NotSpecialCasePrimaryKey) > 0) Or (InStr(strPrimarySkuType, TblPrimaryKey) > 0) Or (InStr(strPrimarySkuType, IndeterminatePrimaryKeyFound) > 0)) Then
  3240. WasPrimaryKeyFound = True
  3241. Else
  3242. WasPrimaryKeyFound = False
  3243. End If
  3244. End Function
  3245.  
  3246.  
  3247. Private Function CanPrimaryKeyTypeBeDetermined(strPrimarySkuType)
  3248. If ((InStr(strPrimarySkuType, IndeterminatePrimaryKeyFound) > 0) Or (InStr(strPrimarySkuType, NoPrimaryKeyFound) > 0)) Then
  3249. CanPrimaryKeyTypeBeDetermined = False
  3250. Else
  3251. CanPrimaryKeyTypeBeDetermined = True
  3252. End If
  3253. End Function
  3254.  
  3255.  
  3256. Private Function GetPrimarySKUType()
  3257. Dim objProduct
  3258. Dim strPrimarySKUType, strDescription
  3259. Dim iIsPrimaryWindowsSku
  3260.  
  3261. For Each objProduct in GetProductCollection(ProductIsPrimarySkuSelectClause, PartialProductKeyNonNullWhereClause)
  3262. strDescription = objProduct.Description
  3263. If (LCase(objProduct.ApplicationId) = WindowsAppId) Then
  3264. iIsPrimaryWindowsSku = GetIsPrimaryWindowsSKU(objProduct)
  3265. If (iIsPrimaryWindowsSku = 1) Then
  3266. If (IsKmsServer(strDescription) Or IsKmsClient(strDescription)) Then
  3267. strPrimarySKUType = strDescription
  3268. Exit For 'no need to continue
  3269. Else
  3270. If IsTBL(strDescription) Then
  3271. strPrimarySKUType = TblPrimaryKey
  3272. Exit For
  3273. Else
  3274. strPrimarySKUType = NotSpecialCasePrimaryKey
  3275. End If
  3276. End If
  3277. ElseIf ((iIsPrimaryWindowsSku = 2) And strPrimarySKUType = "") Then
  3278. strPrimarySKUType = IndeterminatePrimaryKeyFound
  3279. End If
  3280. Else
  3281. strPrimarySKUType = strDescription
  3282. Exit For 'no need to continue
  3283. End If
  3284. Next
  3285.  
  3286. If strPrimarySKUType = "" Then
  3287. strPrimarySKUType = NoPrimaryKeyFound
  3288. End If
  3289.  
  3290. GetPrimarySKUType = strPrimarySKUType
  3291. End Function
  3292.  
  3293. Private Function SetRegistryStr(hKey, strKeyPath, strValueName, strValue)
  3294. SetRegistryStr = g_objRegistry.SetStringValue(hKey, strKeyPath, strValueName, strValue)
  3295. End Function
  3296.  
  3297. Private Function DeleteRegistryValue(hKey, strKeyPath, strValueName)
  3298. DeleteRegistryValue = g_objRegistry.DeleteValue(hKey, strKeyPath, strValueName)
  3299. End Function
  3300.  
  3301. Private Function ExistsRegistryKey(hKey, strKeyPath)
  3302. Dim bGranted
  3303. Dim lRet
  3304.  
  3305. ' Check for KEY_QUERY_VALUE for this key
  3306. lRet = g_objRegistry.CheckAccess(hKey, strKeyPath, 1, bGranted)
  3307.  
  3308. ' Ignore real access rights, just look for existence of the key
  3309. If lRet<>2 Then
  3310. ExistsRegistryKey = True
  3311. Else
  3312. ExistsRegistryKey = False
  3313. End If
  3314. End Function
  3315.  
  3316. ' Resource manipulation
  3317.  
  3318. ' Get the resource string with the given name from the locale specific
  3319. ' dictionary. If not found, use the built-in default.
  3320. Private Function GetResource(name)
  3321. LoadResourceData
  3322. If g_resourceDictionary.Exists(LCase(name)) Then
  3323. GetResource = g_resourceDictionary.Item(LCase(name))
  3324. Else
  3325. GetResource = Eval(name)
  3326. End If
  3327. End Function
  3328.  
  3329. ' Loads resource strings from an ini file of the appropriate locale
  3330. Private Function LoadResourceData
  3331. If g_resourcesLoaded Then
  3332. Exit Function
  3333. End If
  3334.  
  3335. Dim ini, lang
  3336. Dim fso
  3337.  
  3338. Set fso = WScript.CreateObject("Scripting.FileSystemObject")
  3339.  
  3340. On Error Resume Next
  3341. lang = GetUILanguage()
  3342. If Err.Number <> 0 Then
  3343. 'API does not exist prior to Vista so no resources to load
  3344. g_resourcesLoaded = True
  3345. Exit Function
  3346. End If
  3347.  
  3348. ini = fso.GetParentFolderName(WScript.ScriptFullName) & "\slmgr\" _
  3349. & ToHex(lang) & "\" & fso.GetBaseName(WScript.ScriptName) & ".ini"
  3350.  
  3351. If fso.FileExists(ini) Then
  3352. Dim stream
  3353. Const ForReading = 1, TristateTrue = -1 'Read file in unicode format
  3354.  
  3355. Set stream = fso.OpenTextFile(ini, ForReading, False, TristateTrue)
  3356. ReadResources(stream)
  3357. stream.Close
  3358. End If
  3359.  
  3360. g_resourcesLoaded = True
  3361. End Function
  3362.  
  3363. ' Reads resource strings from an ini file
  3364. Private Function ReadResources(stream)
  3365. const ERROR_FILE_NOT_FOUND = 2
  3366. Dim ln, arr, key, value
  3367.  
  3368. If Not IsObject(stream) Then Err.Raise ERROR_FILE_NOT_FOUND
  3369.  
  3370. Do Until stream.AtEndOfStream
  3371. ln = stream.ReadLine
  3372.  
  3373. arr = Split(ln, "=", 2, 1)
  3374. If UBound(arr, 1) = 1 Then
  3375. ' Trim the key and the value first before trimming quotes
  3376. key = LCase(Trim(arr(0)))
  3377. value = TrimChar(Trim(arr(1)), """")
  3378.  
  3379. If key <> "" Then
  3380. g_resourceDictionary.Add key, value
  3381. End If
  3382. End If
  3383. Loop
  3384. End Function
  3385.  
  3386. ' Trim a character from the text string
  3387. Private Function TrimChar(s, c)
  3388. Const vbTextCompare = 1
  3389.  
  3390. ' Trim character from the start
  3391. If InStr(1, s, c, vbTextCompare) = 1 Then
  3392. s = Mid(s, 2)
  3393. End If
  3394.  
  3395. ' Trim character from the end
  3396. If InStr(Len(s), s, c, vbTextCompare) = Len(s) Then
  3397. s = Mid(s, 1, Len(s) - 1)
  3398. End If
  3399.  
  3400. TrimChar = s
  3401. End Function
  3402.  
  3403. ' Get a 4-digit hexadecimal number
  3404. Private Function ToHex(n)
  3405. Dim s : s = Hex(n)
  3406. ToHex = String(4 - Len(s), "0") & s
  3407. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!