Advertisement
adamchilcott

OLicenseCleanup.vbs

Aug 22nd, 2018
515
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. '*******************************************************************************
  2. ' Name: OLicenseCleanup.vbs - v 1.15
  3. ' Author: Microsoft Customer Support Services
  4. ' Copyright (c) Microsoft Corporation
  5. '
  6. ' Removes all licenses for Office 2013 and 2016
  7. ' from the (Office) Software Protection Platform
  8. '*******************************************************************************
  9. 'Option Explicit
  10.  
  11. Dim oProductInstances, oWmiLocal, oReg, oWShell, oFso
  12. Dim sQuery, sTemp, sLogDir, sOSinfo
  13. Dim f64, fO64, fCScript, fQuiet, fClearO15, fClearO16, fSafeForRoamingUsers
  14. Dim LogStream
  15.  
  16. 'Const SKUFILTER = "" 'Removes all licenses
  17. Const SKUFILTER = "O365" 'Removes all licenses that contain O365 in their name
  18. 'Const SKUFILTER = "2013"  'Removes all licenses that contain 2013 in their name
  19. 'Const SKUFILTER = "2016"  'Removes all licenses that contain 2016 in their name
  20.  
  21. fQuiet      = True
  22. fClearO15   = True
  23. fClearO16   = True
  24. sLogDir     = "" 'Custom log folder/directory. No trailing "\" in the path!
  25.  
  26. 'Set this to False if the script needs to run more than once and you don't
  27. 'have roaming profile users
  28. fSafeForRoamingUsers = True  
  29.  
  30.  
  31. '*******************************************************************************
  32.  
  33.  
  34. Const OfficeAppId = "0ff1ce15-a989-479d-af46-f275c6370663"  'Office 2013/2016
  35. Const HKLM  = &H80000002
  36. Const SCRIPTVERSION = "1.15"
  37.  
  38.  
  39. ' MAIN
  40. On Error Resume Next
  41. Set oWShell     = CreateObject("WScript.Shell")
  42.  
  43. Initialize
  44. LogH2 "Cleanup start"
  45. CleanOSPP SKUFILTER
  46. ResetOfficeIdentityKey
  47. ResetOfficeUserRegistrationKey
  48. ResetUserLicensingKey
  49. ClearCredmanCache
  50. ClearSCALicCache
  51. ClearConfigUser
  52. LogH2 "Cleanup end"
  53. ' END
  54.  
  55. '-------------------------------------------------------------------------------
  56. '   Initialize
  57. '
  58. '   Initialize script settings
  59. '-------------------------------------------------------------------------------
  60. Sub Initialize
  61.     Dim ComputerItem, Item
  62.     Dim sOsVersion
  63.  
  64.     'Check if we're running as 32 bit process on a 64 bit OS
  65.    If InStr(LCase(wscript.path), "syswow64") > 0 Then RelaunchAs64Host
  66.  
  67.     Set oWmiLocal   = GetObject("winmgmts:\\.\root\cimv2")
  68.     Set oReg        = GetObject("winmgmts:\\.\root\default:StdRegProv")
  69.     Set oFso        = CreateObject("Scripting.FileSystemObject")
  70.  
  71.     sTemp = oWShell.ExpandEnvironmentStrings("%TEMP%")
  72.     fCScript = (UCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2, 1)) = "C")
  73.  
  74.     ' get Win32_OperatingSystem details
  75.    '----------------------------------
  76.    Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_OperatingSystem")
  77.     For Each Item in ComputerItem
  78.         sOSinfo = sOSinfo & Item.Caption
  79.         sOSinfo = sOSinfo & Item.OtherTypeDescription
  80.         sOSinfo = sOSinfo & ", " & "SP " & Item.ServicePackMajorVersion
  81.         sOSinfo = sOSinfo & ", " & "Version: " & Item.Version
  82.         sOsVersion = Item.Version
  83.         sOSinfo = sOSinfo & ", " & "Codepage: " & Item.CodeSet
  84.         sOSinfo = sOSinfo & ", " & "Country Code: " & Item.CountryCode
  85.         sOSinfo = sOSinfo & ", " & "Language: " & Item.OSLanguage
  86.     Next
  87.  
  88.     DetectOSBitness
  89.     DetectOfficeBitness
  90.     CreateLog
  91.  
  92.     LogOnly "Remove O15 Lic: " & fClearO15
  93.     LogOnly "Remove O16 Lic: " & fClearO16
  94.     LogOnly "Quiet mode:     " & fQuiet
  95. End Sub
  96.  
  97. '-------------------------------------------------------------------------------
  98. '   ResetUserLicensingKey
  99. '
  100. '   clear HKCU cached user license registry
  101. '-------------------------------------------------------------------------------
  102. Sub ResetUserLicensingKey ()
  103.     Dim sSettingsKey, sCount, sRetVal, sCmd
  104.     Dim iCount
  105.     Dim oExec
  106.    
  107.     If fClearO15 Then
  108.         'remove current user key
  109.        Log "Remove key HKCU\Software\Microsoft\Office\15.0\Common\Licensing"
  110.         sRetVal = oWShell.Run("REG DELETE HKCU\Software\Microsoft\Office\15.0\Common\Licensing /f", 0, True)
  111.        
  112.         'create user settings key to cover other profiles
  113.         sSettingsKey = "SOFTWARE\Wow6432Node\Microsoft\Office\15.0\User Settings"
  114.         If (f64 And fO64) Or (Not f64) Then sSettingsKey = "SOFTWARE\Microsoft\Office\15.0\User Settings"
  115.    
  116.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense"
  117.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete"
  118.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software"
  119.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft"
  120.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office"
  121.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office\15.0"
  122.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office\15.0\Common"
  123.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office\15.0\Common\Licensing"
  124.    
  125.         iCount = 1
  126.         If Not fSafeForRoamingUsers Then
  127.             If RegReadDWordValue(HKLM, sSettingsKey & "\ResetUserLicense", "Count", sCount) Then iCount = CInt(sCount) + 1
  128.         End If
  129.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetUserLicense", "Count", iCount
  130.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetUserLicense", "Order", 1
  131.         LogOnly "Add SettingsKey: HKLM\" & sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office\15.0\Common\Licensing"
  132.         LogOnly "Count: " & iCount
  133.     End If
  134.    
  135.    
  136.     'O16
  137.    If fClearO16 Then
  138.         'remove current user key
  139.        Log "Remove key HKCU\Software\Microsoft\Office\16.0\Common\Licensing"
  140.         sRetVal = oWShell.Run("REG DELETE HKCU\Software\Microsoft\Office\16.0\Common\Licensing /f", 0, True)
  141.    
  142.    
  143.         'create user settings key to cover other profiles
  144.         sSettingsKey = "SOFTWARE\Wow6432Node\Microsoft\Office\16.0\User Settings"
  145.         If (f64 And fO64) Or (Not f64) Then sSettingsKey = "SOFTWARE\Microsoft\Office\16.0\User Settings"
  146.    
  147.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense"
  148.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete"
  149.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software"
  150.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft"
  151.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office"
  152.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office\16.0"
  153.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office\16.0\Common"
  154.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office\16.0\Common\Licensing"
  155.    
  156.         iCount = 1
  157.         If Not fSafeForRoamingUsers Then
  158.             If RegReadDWordValue(HKLM, sSettingsKey & "\ResetUserLicense", "Count", sCount) Then iCount = CInt(sCount) + 1
  159.         End If
  160.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetUserLicense", "Count", iCount
  161.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetUserLicense", "Order", 1
  162.         LogOnly "Add SettingsKey: HKLM\" & sSettingsKey & "\ResetUserLicense\Delete\Software\Microsoft\Office\16.0\Common\Licensing"
  163.         LogOnly "Count: " & iCount
  164.     End If
  165.  
  166. End Sub 'ResetUserLicensingKey
  167.  
  168. '-------------------------------------------------------------------------------
  169. '   ClearConfigUser
  170. '
  171. '   clear HKLM cached user license id
  172. '-------------------------------------------------------------------------------
  173. Sub ClearConfigUser
  174.     Dim value
  175.     Dim sConfigKey, sRetVal, sCmd
  176.     Dim arrNames, arrTypes
  177.  
  178.     If NOT fClearO16 Then Exit Sub
  179.  
  180.     sConfigKey = "SOFTWARE\Microsoft\Office\ClickToRun\Configuration"
  181.  
  182.     If RegEnumValues(HKLM, sConfigKey, arrNames, arrTypes) Then
  183.         For Each value in arrNames
  184.             If (InStr(LCase(value), LCase(".EmailAddress")) > 0) Or (InStr(LCase(value), LCase(".TenantId")) > 0) Or (LCase(value) = "productkeys") Then
  185.                 sCmd = "REG DELETE HKLM\" & sConfigKey & " /v " &  value & " /f"
  186.                 sRetVal = oWShell.Run(sCmd, 0, True)
  187.                 Log "Remove entry: HKLM\" & sConfigKey & "\" & value
  188.             End If
  189.         Next
  190.     End If
  191. End Sub 'ClearConfigUser
  192.  
  193. '-------------------------------------------------------------------------------
  194. '   ClearSCALicCache
  195. '
  196. '   clear local license cache for SharedComputerActivation
  197. '-------------------------------------------------------------------------------
  198. Sub ClearSCALicCache
  199.     Dim attr, fld
  200.     Dim sLocalAppData, sCmd, sDelFld
  201.    
  202.     sLocalAppData = oWShell.ExpandEnvironmentStrings("%localappdata%")
  203.    
  204.     If fClearO15 Then
  205.         sDelFld = sLocalAppData & "\Microsoft\Office\15.0\Licensing"
  206.         If oFso.FolderExists(sDelFld) Then
  207.             Set fld = oFso.GetFolder(sDelFld)
  208.             'ensure to remove read only flag
  209.             attr = fld.Attributes
  210.             If CBool(attr And 1) Then fld.Attributes = attr And (attr - 1)
  211.             'delete folder
  212.             fld.Delete True
  213.             Set fld = Nothing
  214.        
  215.             'check if removal succeeded. If not try to RD
  216.             If oFso.FolderExists(sDelFld) Then
  217.                 sCmd = "cmd.exe /c rd /s " & chr(34) & sDelFld & chr(34) & " /q"
  218.                 Log "Remove folder: " & sDelFld
  219.                 oWShell.Run sCmd, 0, True
  220.             End If
  221.         End If
  222.     End If
  223.  
  224.     If fClearO16 Then
  225.         sDelFld = sLocalAppData & "\Microsoft\Office\16.0\Licensing"
  226.         If oFso.FolderExists(sDelFld) Then
  227.             Set fld = oFso.GetFolder(sDelFld)
  228.             'ensure to remove read only flag
  229.             attr = fld.Attributes
  230.             If CBool(attr And 1) Then fld.Attributes = attr And (attr - 1)
  231.             'delete folder
  232.             fld.Delete True
  233.             Set fld = Nothing
  234.        
  235.             'check if removal succeeded. If not try to RD
  236.             If oFso.FolderExists(sDelFld) Then
  237.                 sCmd = "cmd.exe /c rd /s " & chr(34) & sDelFld & chr(34) & " /q"
  238.                 Log "Remove folder: " & sDelFld
  239.                 oWShell.Run sCmd, 0, True
  240.             End If
  241.         End If
  242.     End If
  243.  
  244. End Sub 'ClearSCALicCache
  245.  
  246. '-------------------------------------------------------------------------------
  247. '   ClearCredmanCache
  248. '
  249. '   clear Office credentials from Windows Credentials Manager Cache
  250. '-------------------------------------------------------------------------------
  251. Sub ClearCredmanCache
  252.     Dim oExec, line
  253.     Dim sCmd, sRetVal, sCmdOut, sLine
  254.     Dim arrLines
  255.    
  256.     sCmd = "cmdkey.exe /list:MicrosoftOffice1*"
  257.     Set oExec = oWShell.Exec(sCmd)
  258.     sCmdOut = oExec.StdOut.ReadAll()
  259.     Do While oExec.Status = 0
  260.          WScript.Sleep 100
  261.     Loop
  262.     arrLines = Split(sCmdOut)
  263.     For Each line In arrLines
  264.         If InStr(line, "MicrosoftOffice1") > 0 And Not InStr(line, "MicrosoftOffice1*") > 0 Then
  265.             sLine = Replace(line, vbCrLf, "")
  266.             sCmd = "cmdkey.exe /delete:" & Trim(sLine)
  267.             Log "Remove from CredmanCache: " & sLine
  268.             sRetVal = oWShell.Run(sCmd, 0, True)
  269.         End If
  270.     Next
  271. End Sub 'ClearCredmanCache
  272.  
  273. '-------------------------------------------------------------------------------
  274. '   ResetOfficeIdentityKey
  275. '
  276. '   configures the Office Identity key to be reset on next application launch
  277. '-------------------------------------------------------------------------------
  278. Sub ResetOfficeIdentityKey ()
  279.     Dim sSettingsKey, sCount, sRetVal, sCmd
  280.     Dim iCount
  281.     Dim oExec
  282.    
  283.     If fClearO15 Then
  284.         'remove current user key
  285.        Log "Remove key HKCU\Software\Microsoft\Office\15.0\Common\Identity"
  286.         sRetVal = oWShell.Run("REG DELETE HKCU\Software\Microsoft\Office\15.0\Common\Identity /f", 0, True)
  287.        
  288.         'create user settings key to cover other profiles
  289.         sSettingsKey = "SOFTWARE\Wow6432Node\Microsoft\Office\15.0\User Settings"
  290.         If (f64 And fO64) Or (Not f64) Then sSettingsKey = "SOFTWARE\Microsoft\Office\15.0\User Settings"
  291.    
  292.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity"
  293.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete"
  294.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software"
  295.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft"
  296.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office"
  297.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office\15.0"
  298.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office\15.0\Common"
  299.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office\15.0\Common\Identity"
  300.    
  301.         iCount = 1
  302.         If Not fSafeForRoamingUsers Then
  303.             If RegReadDWordValue(HKLM, sSettingsKey & "\ResetIdentity", "Count", sCount) Then iCount = CInt(sCount) + 1
  304.         End If
  305.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetIdentity", "Count", iCount
  306.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetIdentity", "Order", 1
  307.         LogOnly "Add SettingsKey: HKLM\" & sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office\15.0\Common\Identity"
  308.         LogOnly "Count: " & iCount
  309.     End If
  310.  
  311.     If fClearO16 Then
  312.         'remove current user key
  313.        Log "Remove key HKCU\Software\Microsoft\Office\16.0\Common\Identity"
  314.         sRetVal = oWShell.Run("REG DELETE HKCU\Software\Microsoft\Office\16.0\Common\Identity /f", 0, True)
  315.    
  316.         'create user settings key to cover other profiles
  317.         sSettingsKey = "SOFTWARE\Wow6432Node\Microsoft\Office\16.0\User Settings"
  318.         If (f64 And fO64) Or (Not f64) Then sSettingsKey = "SOFTWARE\Microsoft\Office\16.0\User Settings"
  319.    
  320.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity"
  321.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete"
  322.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software"
  323.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft"
  324.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office"
  325.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office\16.0"
  326.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office\16.0\Common"
  327.         oReg.CreateKey HKLM, sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office\16.0\Common\Identity"
  328.    
  329.         iCount = 1
  330.         If Not fSafeForRoamingUsers Then
  331.             If RegReadDWordValue(HKLM, sSettingsKey & "\ResetIdentity", "Count", sCount) Then iCount = CInt(sCount) + 1
  332.         End If
  333.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetIdentity", "Count", iCount
  334.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetIdentity", "Order", 1
  335.         LogOnly "Add SettingsKey: HKLM\" & sSettingsKey & "\ResetIdentity\Delete\Software\Microsoft\Office\16.0\Common\Identity"
  336.         LogOnly "Count: " & iCount
  337.     End If
  338.  
  339. End Sub 'ResetOfficeIdentityKey
  340.  
  341. '-------------------------------------------------------------------------------
  342. '   ResetOfficeUserRegistrationKey
  343. '
  344. '   configures the Office Identity key to be reset on next application launch
  345. '-------------------------------------------------------------------------------
  346. Sub ResetOfficeUserRegistrationKey ()
  347.     Dim sSettingsKey, sCount, sRetVal, sCmd
  348.     Dim iCount
  349.     Dim oExec
  350.    
  351.     If fClearO15 Then
  352.         'remove current user key
  353.        Log "Remove key HKCU\Software\Microsoft\Office\15.0\Registration"
  354.         sRetVal = oWShell.Run("REG DELETE HKCU\Software\Microsoft\Office\15.0\Registration /f", 0, True)
  355.        
  356.         'create user settings key to cover other profiles
  357.         sSettingsKey = "SOFTWARE\Wow6432Node\Microsoft\Office\15.0\User Settings"
  358.         If (f64 And fO64) Or (Not f64) Then sSettingsKey = "SOFTWARE\Microsoft\Office\15.0\User Settings"
  359.    
  360.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration"
  361.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete"
  362.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software"
  363.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft"
  364.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft\Office"
  365.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft\Office\15.0"
  366.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft\Office\15.0\Registration"
  367.    
  368.         iCount = 1
  369.         If Not fSafeForRoamingUsers Then
  370.             If RegReadDWordValue(HKLM, sSettingsKey & "\ResetUserRegistration", "Count", sCount) Then iCount = CInt(sCount) + 1
  371.         End If
  372.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetUserRegistration", "Count", iCount
  373.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetUserRegistration", "Order", 1
  374.         LogOnly "Add SettingsKey: HKLM\" & sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft\Office\15.0\Registration"
  375.         LogOnly "Count: " & iCount
  376.     End If
  377.    
  378.     If fClearO16 Then
  379.         'remove current user key
  380.        Log "Remove key HKCU\Software\Microsoft\Office\16.0\Registration"
  381.         sRetVal = oWShell.Run("REG DELETE HKCU\Software\Microsoft\Office\16.0\Registration /f", 0, True)
  382.    
  383.         'create user settings key to cover other profiles
  384.         sSettingsKey = "SOFTWARE\Wow6432Node\Microsoft\Office\16.0\User Settings"
  385.         If (f64 And fO64) Or (Not f64) Then sSettingsKey = "SOFTWARE\Microsoft\Office\16.0\User Settings"
  386.    
  387.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration"
  388.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete"
  389.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software"
  390.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft"
  391.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft\Office"
  392.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft\Office\16.0"
  393.         oReg.CreateKey HKLM, sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft\Office\16.0\Registration"
  394.    
  395.         iCount = 1
  396.         If Not fSafeForRoamingUsers Then
  397.             If RegReadDWordValue(HKLM, sSettingsKey & "\ResetUserRegistration", "Count", sCount) Then iCount = CInt(sCount) + 1
  398.         End If
  399.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetUserRegistration", "Count", iCount
  400.         oReg.SetDWordValue HKLM, sSettingsKey & "\ResetUserRegistration", "Order", 1
  401.         LogOnly "Add SettingsKey: HKLM\" & sSettingsKey & "\ResetUserRegistration\Delete\Software\Microsoft\Office\16.0\Registration"
  402.         LogOnly "Count: " & iCount
  403.     End If
  404.  
  405. End Sub 'ResetOfficeUserRegistrationKey
  406.  
  407. '-------------------------------------------------------------------------------
  408. '   CleanOSPP
  409. '
  410. '   unpkeys the licenses from OSPP
  411. '-------------------------------------------------------------------------------
  412. Sub CleanOSPP (sFilter)
  413.     Dim pi
  414.     Dim oProductInstances
  415.  
  416.     ' Initialize the software protection platform object with a filter on Office 2013/2016 products
  417.     If GetVersionNT > 601 Then
  418.         Set oProductInstances = oWmiLocal.ExecQuery("SELECT ID, ApplicationId, PartialProductKey, Description, Name, ProductKeyID FROM SoftwareLicensingProduct WHERE ApplicationId = '" & OfficeAppId & "' " & "AND PartialProductKey <> NULL")
  419.     Else
  420.         Set oProductInstances = oWmiLocal.ExecQuery("SELECT ID, ApplicationId, PartialProductKey, Description, Name, ProductKeyID FROM OfficeSoftwareProtectionProduct WHERE ApplicationId = '" & OfficeAppId & "' " & "AND PartialProductKey <> NULL")
  421.     End If
  422.    
  423.     ' Remove all licenses
  424.     For Each pi in oProductInstances
  425.         Log "License: " & pi.Name
  426.         If NOT IsNull(pi) Then
  427.             If InStr(pi.Name, sFilter) > 0 Or sFilter = "" Then
  428.                 Log "Uninstall ProductKey: " & pi.Name & " - Key: " & pi.ProductKeyID
  429.                 pi.UninstallProductKey(pi.ProductKeyID)
  430.             End If
  431.         End If
  432.     Next 'pi
  433. End Sub 'CleanOSPP
  434.  
  435. '-------------------------------------------------------------------------------
  436. '   DetectOfficeBitness
  437. '
  438. '   detect bitness of Office
  439. '-------------------------------------------------------------------------------
  440. Sub DetectOfficeBitness ()
  441.     Dim sOPlatform, sInstallRootPath
  442.  
  443.     fO64 = False
  444.     If Not f64 Then Exit Sub
  445.     If RegReadStringValue(HKLM, "SOFTWARE\Microsoft\Office\ClickToRun\Configuration", "platform", sOPlatform) Then
  446.         fO64 = (sOPlatform = "x64")
  447.         Exit Sub
  448.     End If
  449.     If RegReadStringValue(HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun\Configuration", "platform", sOPlatform) Then
  450.         fO64 = (sOPlatform = "x64")
  451.         Exit Sub
  452.     End If
  453.     If RegReadStringValue(HKLM, "SOFTWARE\Microsoft\Office\ClickToRun\propertyBag", "Platform", sOPlatform) Then
  454.         fO64 = (sOPlatform = "x64")
  455.         Exit Sub
  456.     End If
  457.     If RegReadStringValue(HKLM, "SOFTWARE\Microsoft\Office\15.0\ClickToRun\propertyBag", "Platform", sOPlatform) Then
  458.         fO64 = (sOPlatform = "x64")
  459.         Exit Sub
  460.     End If
  461.     If RegReadStringValue(HKLM, "SOFTWARE\Wow6432Node\Microsoft\Office\Common\InstallRoot", "Path", sInstallRootPath) Then
  462.         'fO64 = Not (InStr(sInstallRootPath,"(x86)") > 0)
  463.         fO64 = False
  464.         Exit Sub
  465.     End If
  466.     If RegReadStringValue(HKLM, "SOFTWARE\Wow6432Node\Microsoft\Office\15.0\Common\InstallRoot", "Path", sInstallRootPath) Then
  467.         'fO64 = Not (InStr(sInstallRootPath,"(x86)") > 0)
  468.         fO64 = False
  469.         Exit Sub
  470.     End If
  471.     If RegReadStringValue(HKLM, "SOFTWARE\Microsoft\Office\Common\InstallRoot", "Path", sInstallRootPath) Then
  472.         'fO64 = Not (InStr(sInstallRootPath,"(x86)") > 0)
  473.         fO64 = True
  474.         Exit Sub
  475.     End If
  476.     If RegReadStringValue(HKLM, "SOFTWARE\Microsoft\Office\15.0\Common\InstallRoot", "Path", sInstallRootPath) Then
  477.         'fO64 = Not (InStr(sInstallRootPath,"(x86)") > 0)
  478.         fO64 = True
  479.         Exit Sub
  480.     End If
  481.  
  482. End Sub 'DetectOfficeBitness
  483.  
  484. '-------------------------------------------------------------------------------
  485. '   DetectOSBitness
  486. '
  487. '   detect bitness of the operating system
  488. '-------------------------------------------------------------------------------
  489. Sub DetectOSBitness ()
  490.     Dim ComputerItem, item
  491.    
  492.     Set ComputerItem = oWmiLocal.ExecQuery("Select * from Win32_ComputerSystem")
  493.     For Each item In ComputerItem
  494.         f64 = Instr(Left(item.SystemType, 3), "64") > 0
  495.     Next
  496. End Sub 'DetectOSBitness
  497.  
  498. '-------------------------------------------------------------------------------
  499. '   GetVersionNT
  500. '
  501. '   Calculate the VerionNT number as integer
  502. '-------------------------------------------------------------------------------
  503. Function GetVersionNT ()
  504.     Dim sOsVersion
  505.     Dim arrVersion
  506.     Dim qOS
  507.     Dim oOsItem
  508.  
  509.     Set qOS = oWmiLocal.ExecQuery( "Select * from Win32_OperatingSystem")
  510.     For Each oOsItem in qOS
  511.         sOsVersion = oOsItem.Version
  512.     Next
  513.     arrVersion = Split( sOsVersion, GetDelimiter( sOsVersion))
  514.     GetVersionNT = CInt( arrVersion( 0)) * 100 + CInt( arrVersion( 1))
  515. End Function
  516.  
  517. '-------------------------------------------------------------------------------
  518. '   GetDelimiter
  519. '
  520. '   Returns the delimiter in a version string
  521. '-------------------------------------------------------------------------------
  522. Function GetDelimiter (sVersion)
  523.     Dim iCnt, iAsc
  524.  
  525.     GetDelimiter = " "
  526.     For iCnt = 1 To Len(sVersion)
  527.         iAsc = Asc(Mid(sVersion, iCnt, 1))
  528.         If Not (iASC >= 48 And iASC <= 57) Then
  529.             GetDelimiter = Mid(sVersion, iCnt, 1)
  530.             Exit Function
  531.         End If
  532.     Next 'iCnt
  533. End Function
  534.  
  535. '-------------------------------------------------------------------------------
  536. '   RegReadDWordValue
  537. '
  538. '   Check if a string value exists and return on zero if not
  539. '-------------------------------------------------------------------------------
  540. Function RegReadDWordValue(hDefKey, sSubKeyName, sName, sValue)
  541.     Dim RetVal
  542.    
  543.     RetVal = oReg.GetDWORDValue(hDefKey, sSubKeyName, sName, sValue)
  544.     RegReadDWordValue = (RetVal = 0)
  545.    
  546. End Function 'RegReadDWordValue
  547.  
  548. '-------------------------------------------------------------------------------
  549. '   RegReadStringValue
  550. '
  551. '   Check if a string value exists and return on zero if not
  552. '-------------------------------------------------------------------------------
  553. Function RegReadStringValue(hDefKey, sSubKeyName, sName, sValue)
  554.     Dim RetVal
  555.    
  556.     RetVal = oReg.GetStringValue(hDefKey, sSubKeyName, sName, sValue)
  557.     RegReadStringValue = (RetVal = 0)
  558.    
  559. End Function 'RegReadSringValue
  560.  
  561. '-------------------------------------------------------------------------------
  562. '   RegEnumValues
  563. '
  564. '   Enumerate a registry key to return all values
  565. '-------------------------------------------------------------------------------
  566. Function RegEnumValues(hDefKey, sSubKeyName, arrNames, arrTypes)
  567.     Dim RetVal
  568.    
  569.     RetVal = oReg.EnumValues(hDefKey, sSubKeyName, arrNames, arrTypes)
  570.     RegEnumValues = (RetVal = 0) AND IsArray(arrNames) AND IsArray(arrTypes)
  571. End Function 'RegEnumValues
  572.  
  573. '-------------------------------------------------------------------------------
  574. '   RelaunchAs64Host
  575. '
  576. '   Relaunch self with 64 bit CScript host
  577. '-------------------------------------------------------------------------------
  578. Sub RelaunchAs64Host
  579.     Dim Argument, sCmd
  580.     Dim fQuietRelaunch
  581.  
  582.     fQuietRelaunch = False
  583.     sCmd = Replace(LCase(wscript.Path), "syswow64", "sysnative") & "\cscript.exe " & Chr(34) & WScript.scriptFullName & Chr(34)
  584.     If fQuiet Then fQuietRelaunch = True
  585.     If Wscript.Arguments.Count > 0 Then
  586.         For Each Argument in Wscript.Arguments
  587.             sCmd = sCmd  &  " " & chr(34) & Argument & chr(34)
  588.             Select Case UCase(Argument)
  589.             Case "/Q", "/QUIET"
  590.                 fQuietRelaunch = True
  591.             End Select
  592.         Next 'Argument
  593.    End If
  594.     sCmd = sCmd & " /ChangedHostBitness"
  595.     If fQuietRelaunch Then
  596.         sCmd = Replace (sCmd, "\cscript.exe", "\wscript.exe")
  597.         Wscript.Quit CLng(oWShell.Run (sCmd, 0, True))
  598.     Else
  599.         Wscript.Quit CLng(oWShell.Run (sCmd, 1, True))
  600.     End If
  601.  
  602. End Sub 'RelaunchAs64Host
  603.  
  604. '-------------------------------------------------------------------------------
  605. '   CreateLog
  606. '
  607. '   Create the removal log file
  608. '-------------------------------------------------------------------------------
  609. Sub CreateLog
  610.     Dim DateTime
  611.     Dim sLogName
  612.    
  613.     On Error Resume Next
  614.     ' create the log file
  615.    Set DateTime = CreateObject("WbemScripting.SWbemDateTime")
  616.     DateTime.SetVarDate Now, True
  617.     If sLogDir = "" Then sLogDir = sTemp
  618.     sLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
  619.     sLogName = sLogName &  "_" & Left(DateTime.Value, 14)
  620.     sLogName = sLogName & "_OLicenseClean.txt"
  621.     Err.Clear
  622.     Set LogStream = oFso.CreateTextFile(sLogName, True, True)
  623.     If Err <> 0 Then
  624.         Err.Clear
  625.         sLogDir = sTemp
  626.         sLogName = sLogDir & "\" & oWShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
  627.         sLogName = sLogName &  "_" & Left(DateTime.Value, 14)
  628.         sLogName = sLogName & "_oLicenseClean.txt"
  629.         Set LogStream = oFso.CreateTextFile(sLogName, True, True)
  630.     End If
  631.     On Error Goto 0
  632.  
  633.     LogH2 "Microsoft Customer Support Services - Office License Reset Utility" & vbCrLf & vbCrLf & _
  634.             "Version: " & vbTab & SCRIPTVERSION & vbCrLf & _
  635.             "64 bit OS: " & vbTab & f64 & vbCrLf & _
  636.             "64 bit Office: " & vbTab & fO64 & vbCrLf & _
  637.             "Cleanup start: " & vbTab & Time
  638.     LogH2   "OS Details: " & sOSinfo & vbCrLf
  639. End Sub 'CreateLog
  640.  
  641. '-------------------------------------------------------------------------------
  642. '   LogH
  643. '
  644. '   Write a header log string to the log file
  645. '-------------------------------------------------------------------------------
  646. Sub LogH (sLog)
  647.     LogStream.WriteLine ""
  648.     sLog = sLog & vbCrLf & String(Len(sLog), "=")
  649.     If NOT fQuiet AND fCScript Then wscript.echo ""
  650.     If NOT fQuiet AND fCScript Then wscript.echo sLog
  651.     LogStream.WriteLine sLog
  652. End Sub 'Logh
  653.  
  654. '-------------------------------------------------------------------------------
  655. '   LogH1
  656. '
  657. '   Write a header log string to the log file
  658. '-------------------------------------------------------------------------------
  659. Sub LogH1 (sLog)
  660.     LogStream.WriteLine ""
  661.     sLog = sLog & vbCrLf & String(Len(sLog), "-")
  662.     If NOT fQuiet AND fCScript Then wscript.echo ""
  663.     If NOT fQuiet AND fCScript Then wscript.echo sLog
  664.     LogStream.WriteLine sLog
  665. End Sub 'LogH1
  666.  
  667. '-------------------------------------------------------------------------------
  668. '   LogH2
  669. '
  670. '   Write w/o indent Cmd window and the log file
  671. '-------------------------------------------------------------------------------
  672. Sub LogH2 (sLog)
  673.     If NOT fQuiet AND fCScript Then wscript.echo sLog
  674.     LogStream.WriteLine ""
  675.     LogStream.WriteLine sLog
  676. End Sub 'LogH2
  677.  
  678. '-------------------------------------------------------------------------------
  679. '   Log
  680. '
  681. '   Echos the log string to the Cmd window and the log file
  682. '-------------------------------------------------------------------------------
  683. Sub Log (sLog)
  684.     If NOT fQuiet AND fCScript Then wscript.echo sLog
  685.     If sLog = "" Then
  686.         LogStream.WriteLine
  687.     Else
  688.         LogStream.WriteLine "   " & Time & ": " & sLog
  689.     End If
  690. End Sub 'Log
  691.  
  692. '-------------------------------------------------------------------------------
  693. '   LogOnly
  694. '
  695. '   Commits the log string to the log file
  696. '-------------------------------------------------------------------------------
  697. Sub LogOnly (sLog)
  698.     If sLog = "" Then
  699.         LogStream.WriteLine
  700.     Else
  701.         LogStream.WriteLine "   " & Time & ": " & sLog
  702.     End If
  703. End Sub 'Log
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement