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 & „rootcimv2”)

    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 = „Softwarewow6432node”

    else

   sBit = „Software”

    end if

    Set objReg=GetObject(„winmgmts:{impersonationLevel=impersonate}!\.rootdefault:StdRegProv”)

    objReg.EnumKey HKEY_LOCAL_MACHINE, sBit & „MicrosoftOffice” & 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 & „MicrosoftOffice” & sVer & „Registration” & SubKey & „ProductName”)

       if ucase(right(SubKey, 7)) = „0FF1CE}” then

                Set wshshell = CreateObject(„WScript.Shell”)

           key = ConvertToKey(wshshell.RegRead(„HKLM” & sBit & „MicrosoftOffice” & sVer & „Registration” & SubKey & „DigitalProductID”))

      oem = ucase(mid(wshshell.RegRead(„HKLM” & sBit & „MicrosoftOffice” & sVer & „Registration” & SubKey & „ProductID”), 7, 3))

        edition = wshshell.RegRead(„HKLM” & sBit & „MicrosoftOffice” & 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(„HKLMSOFTWAREMicrosoftWindows NTCurrentVersionProductName”)

    oem = ucase(mid(wshshell.RegRead(„HKLMSOFTWAREMicrosoftWindows NTCurrentVersionProductID”), 7, 3))

    key = GetKey(„HKLMSOFTWAREMicrosoftWindows NTCurrentVersionDigitalProductId”)

    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

---

Dziękuję Ci, za poświęcony czas na przeczytanie tego artykułu. Jeśli był on dla Ciebie przydatny, to gorąco zachęcam Cię do zapisania się na mój newsletter, jeżeli jeszcze Cię tam nie ma. Proszę Cię także o “polubienie” mojego bloga na Facebooku oraz kanału na YouTube – pomoże mi to dotrzeć do nowych odbiorców. Raz w tygodniu (niedziela punkt 17.00) otrzymasz powiadomienia o nowych artykułach / projektach zanim staną się publiczne. Możesz również pozostawić całkowicie anonimowy pomysł na wpis/nagranie.

Link do formularza tutaj: https://beitadmin.pl/pomysly

Pozostaw również komentarz lub napisz do mnie wiadomość odpisuję na każdą, jeżeli Masz jakieś pytania:).