poniedziałek, 11 listopada 2013

Skrypt pokazujący klucz systemu Windows (7,8,10) oraz Office(2007,2010,2013) - Skrypty VBS cz.10

Czasami zachodzi potrzeba wyciągnięcia klucza zarówno z Windows jak i Office. Oczywiście można użyć programów takich jak np.: http://www.instalki.pl/programy/Download/Windows/odzyskiwanie_klucza.html. Jednak przy np. 40 stacjach, na których trzeba zainstalować taki program może być dużym utrudnieniem a na pewno jest stratą czasu. Dlatego można utworzyć skrypt z opcją dopisywania informacji do pliku i w ten sposób po krótkim spacerze po firmie zebrać potrzebne nam informacje do przygotowania inwentaryzacji.
Wrzucamy skrypt np. na pendrive w tej samej lokalizacji mamy plik do którego będą dopisywane informacje o nazwie komputera, kluczu Windows oraz Office.Dzięki czemu po kilkunastu minutach mamy zrobiony backup kluczy, który możemy wykorzystać w przypadku ponownej instalacji systemu lub pakietu Office.

Skrypt pokazuje klucze dla:
- Windows XP; 7;8;8.1;10
- Office 2003, 2007,2007,2013

Const HKEY_LOCAL_MACHINE = &H80000002

WinKey = GetWinKey
strComputer="."


OfficeKeys = GetOfficeKey("10.0") & GetOfficeKey("11.0") & GetOfficeKey("12.0") & GetOfficeKey("14.0") & GetOfficeKey("15.0")

If Msgbox(WinKey & vbnewline & vbnewline & OfficeKeys & vbnewline & "Save All Keys to ProductKeys.txt?", vbyesno, "GetProductKeys.VBS by Foolish IT") = vbyes then
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colSystem = objWMIService.ExecQuery ("Select * from Win32_ComputerSystem")
    'Set objTextFile1 = objFSO.CreateTextFile("ProductKeys.txt" ,True)
    Set objTextFile = objFSO.OpenTextFile("_ProductKeys.txt",8) 
   For Each objComputer in colSystem
    objTextFile.WriteLine "Nazwa: " & objComputer.Name 
   Next 
   objTextFile.WriteLine ""
   objTextFile.WriteLine WinKey & vbnewline & vbnewline & OfficeKeys 
    objTextFile.WriteLine "---------------------------------------------------------------------------------------------------------------------------------"
    objTextFile.Close
end if

Function GetOfficeKey(sVer)
    On Error Resume Next
    Dim arrSubKeys
    Set wshShell = WScript.CreateObject( "WScript.Shell" )
    sBit = wshShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
    if sBit <> "%ProgramFiles(x86)%" then
   sBit = "Software\wow6432node"
    else
   sBit = "Software"
    end if
    Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    objReg.EnumKey HKEY_LOCAL_MACHINE, sBit & "\Microsoft\Office\" & sVer & "\Registration", arrSubKeys
    Set objReg = Nothing
    if IsNull(arrSubKeys) = False then
        For Each Subkey in arrSubKeys
       if lenb(other) < 1 then other = wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductName")
       if ucase(right(SubKey, 7)) = "0FF1CE}" then
                Set wshshell = CreateObject("WScript.Shell")
           key = ConvertToKey(wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\DigitalProductID"))
      oem = ucase(mid(wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductID"), 7, 3))
        edition = wshshell.RegRead("HKLM\" & sBit & "\Microsoft\Office\" & sVer & "\Registration\" & SubKey & "\ProductName")
      if err.number <> 0 then 
          edition = other
                   err.clear
      end if
           Set wshshell = Nothing
            if oem <> "OEM" then oem = "Retail"
           if lenb(final) > 1 then
          final = final & vbnewline & final
             else
               final = edition & " " & oem & ":  " & key 
                end if
       end if
        Next
   GetOfficeKey = final & vbnewline
    End If
End Function

Function GetWinKey()
    Set wshshell = CreateObject("WScript.Shell")
    edition = wshshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
    oem = ucase(mid(wshshell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductID"), 7, 3))
    key = GetKey("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")
    set wshshell = Nothing
    if oem <> "OEM" then oem = "Retail"
    GetWinKey = edition & " " & oem & ":  " & key
End Function

Function GetKey(sReg)
    Set wshshell = CreateObject("WScript.Shell")
    GetKey = ConvertToKey(wshshell.RegRead(sReg))
    Set wshshell = Nothing
End Function

Function ConvertToKey(key)
    Const KeyOffset = 52
    i = 28
    Chars = "BCDFGHJKMPQRTVWXY2346789"
    Do
        Cur = 0
        x = 14
        Do
            Cur = Cur * 256
            Cur = key(x + KeyOffset) + Cur
            key(x + KeyOffset) = (Cur \ 24) And 255
            Cur = Cur Mod 24
            x = x - 1
        Loop While x >= 0
        i = i - 1
        KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
        If (((29 - i) Mod 6) = 0) And (i <> -1) Then
            i = i - 1
            KeyOutput = "-" & KeyOutput
        End If
    Loop While i >= 0
    ConvertToKey = KeyOutput
End Function



4 komentarze:

  1. Nie pokazuje klucza Office 2013 :(

    OdpowiedzUsuń
  2. Spróbuj tego, wklej zapytanie do cmd


    For 32 bit Windows:

    cscript “C:\Program Files\Microsoft Office\Office15\OSPP.VBS” /dstatus

    For 64 bit Windows:

    cscript “C:\Program Files (x86)\Microsoft Office\Office15\OSPP.VBS” /dstatus

    OdpowiedzUsuń
  3. pomocy:) U mnie jest coś takiego
    G:\klucz\OSPP.vbs(1, 1) Microsoft VBScript - błąd kompilacji: Nieprawidłowy znak
    Proszę o pomoc.

    OdpowiedzUsuń
    Odpowiedzi
    1. Proszę o maila na adres:problemydorozwiazania@gmail.com podeślę jeszcze jeden skrypt.

      Usuń