Windows - licenční klíč

[Dreizak]

Dobrý den,
mohl bych se Vás zeptat, jak zjistím svůj licenční klíč od Windows (notebook), kvůli případné reinstalaci?

Děkuji.

[marek5816]

Na notebooku by mal byť štítok pravosti takzvaný COA, ak tam neni tak tu je menší návod

[robert333]

Popřípadně pokud nechceš instalovat žádný software, otevři poznámkový blok a vlož do něj toto:

Kód: Vybrat vše

Option Explicit  
 
Dim objshell,path,DigitalID, Result  
Set objshell = CreateObject("WScript.Shell") 
'Set registry key path 
Path = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\" 
'Registry key value 
DigitalID = objshell.RegRead(Path & "DigitalProductId") 
Dim ProductName,ProductID,ProductKey,ProductData 
'Get ProductName, ProductID, ProductKey 
ProductName = "Product Name: " & objshell.RegRead(Path & "ProductName") 
ProductID = "Product ID: " & objshell.RegRead(Path & "ProductID") 
ProductKey = "Installed Key: " & ConvertToKey(DigitalID)  
ProductData = ProductName  & vbNewLine & ProductID  & vbNewLine & ProductKey 
'Show messbox if save to a file  
If vbYes = MsgBox(ProductData  & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "BackUp Windows Key Information") then 
   Save ProductData  
End If 
 
 
 
'Convert binary to chars 
Function ConvertToKey(Key) 
    Const KeyOffset = 52 
    Dim isWin8, Maps, i, j, Current, KeyOutput, Last, keypart1, insert 
    'Check if OS is Windows 8 
    isWin8 = (Key(66) \ 6) And 1 
    Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4) 
    i = 24 
    Maps = "BCDFGHJKMPQRTVWXY2346789" 
    Do 
           Current= 0 
        j = 14 
        Do 
           Current = Current* 256 
           Current = Key(j + KeyOffset) + Current 
           Key(j + KeyOffset) = (Current \ 24) 
           Current=Current Mod 24 
            j = j -1 
        Loop While j >= 0 
        i = i -1 
        KeyOutput = Mid(Maps,Current+ 1, 1) & KeyOutput 
        Last = Current 
    Loop While i >= 0  
     
    If (isWin8 = 1) Then 
        keypart1 = Mid(KeyOutput, 2, Last) 
        insert = "N" 
        KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0) 
        If Last = 0 Then KeyOutput = insert & KeyOutput 
    End If     
     
 
    ConvertToKey = Mid(KeyOutput, 1, 5) & "-" & Mid(KeyOutput, 6, 5) & "-" & Mid(KeyOutput, 11, 5) & "-" & Mid(KeyOutput, 16, 5) & "-" & Mid(KeyOutput, 21, 5) 
    
     
End Function 
'Save data to a file 
Function Save(Data) 
    Dim fso, fName, txt,objshell,UserName 
    Set objshell = CreateObject("wscript.shell") 
    'Get current user name  
    UserName = objshell.ExpandEnvironmentStrings("%UserName%")  
    'Create a text file on desktop  
    fName = "C:\Users\" & UserName & "\Desktop\WindowsKeyInfo.txt" 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set txt = fso.CreateTextFile(fName) 
    txt.Writeline Data 
    txt.Close 
End Function 

Klikni na Soubor - Uložit jako... a do názvu napiš winkey.vbs a u typu souboru zvol Všechny soubory.
No a až to uložíš, tak to spusť a ten skript ti vypíše jak Product Key, tak ID produktu.
Jestli se ti to nechce dělat ručně, tak ten skript je ke stažení zde: http://winaero.com/download.php?view.1781

[Dreizak]

Dekuji. Az se dostanu na pc tak to vyzkousim. Chci se ale zeptat, bude mi to fungovat na windows 10? V tom scriptu vidim samou 8cku..

[marek5816]

Popřípadně pokud nechceš instalovat žádný software

V návode ktorý som posielal neni software na inštalovanie ale je to priamo program

Chci se ale zeptat, bude mi to fungovat na windows 10?

Script ktorí posielal robert333 funguje aj na windows 10, pokiaľ ste windows 10 nainštalovali free upgradom tak si môžete prečítať krátky text na konci návodu čo som poslal

Nezapomínejme také, že instalace Windows 10 provedené jako upgrade ze starších verzí systémů Windows 7/8/8.1 mají obecné produktové kódy které jsou vždy stejné

[Dreizak]

Hotovo, už svůj licenční klíč mám díky tomu scriptu.

Mockrát děkuji za radu! Tohle téma můžete již zamknout, vyřešeno.

[Roli]

Tohle téma můžete již zamknout, vyřešeno.

Na žádost