Mit einem Script den vorinstallierten und jetzigen Key auslesen

Details
Bis heute sind es 8315 Zugriffe.

Hat man Windows 10 mit einem Key installiert und danach den Key gewechselt (Installation des Media Centers), so wird mit einfachen Tools nur der letzte Produktschlüssel angezeigt.


Keys, Seriennummer in der Registry

Es gibt zwei Speicherorte für die Keys in der Registry. Es werden unter beiden verschiedene angezeigt, wenn man zum Beispiel das Media Center installiert.


Insert code here
    HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion 
DigitalProductId = Die derzeitige installierte Seriennummer (Windows 10 oder Media Center.
    HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey 
DigitalProductId = Die Seriennummer mit der Windows 10 installiert wurde.

Anders beim Script (Lizenzkey.vbs) von Areiland. Dieser liest aus der Registry beide Schlüssel aus.



Datei entpacken
Lizenzkey.vbs mit einem Doppelklick starten
Lezenzkey nun abschreiben oder als Textdatei abspeichern.

Download: Lizenzkeys


So geht's:

  1. Öffnen Sie einen Texteditor (z.B.: "Notepad.exe").
  2. Kopieren Sie das unten stehende VBScript in den Editor.
  3. Speichern Sie die Datei unter einem beliebigen Namen mit der Dateiendung ".vbs" ab. Z.B.: "ProductKey.vbs"
  4. Öffnen Sie den Windows-Explorer (bzw. "Arbeitsplatz" / "Computer")
  5. Mit einem Doppelklick kann das Skript nun ausgeführt werden.
  6. Es wird die aktuelle Windowsversion und der Produktschlüssel angezeigt.
Set WshShell = CreateObject("WScript.Shell")
Key = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey\"
DigitalID = WshShell.RegRead(key & "DigitalProductId")
 
ProductID = "Product ID: " & WshShell.RegRead(Key & "ProductID") & vbNewLine
ProductKey = "Installed Key: " & ConvertToKey(DigitalID)
ProductID = ProductName & ProductID & ProductKey
 
If vbYes = MsgBox(ProductId & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "Windows Key Information") then
   Save ProductID
End if
 
Function ConvertToKey(Key)
    Const KeyOffset = 52
    isWin8 = (Key(66) \ 6) And 1
    Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
    i = 24
    Chars = "BCDFGHJKMPQRTVWXY2346789"
        Do
        Cur = 0
        X = 14
        Do
            Cur = Cur * 256
            Cur = Key(X + KeyOffset) + Cur
            Key(X + KeyOffset) = (Cur \ 24)
            Cur = Cur Mod 24
            X = X -1
        Loop While X >= 0
        i = i -1
        KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
        Last = Cur
    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
    a = Mid(KeyOutput, 1, 5)
    b = Mid(KeyOutput, 6, 5)
    c = Mid(KeyOutput, 11, 5)
    d = Mid(KeyOutput, 16, 5)
    e = Mid(KeyOutput, 21, 5)
    ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function
 
Function Save(Data)
    Const ForWRITING = 2
    Const asASCII = 0
    Dim fso, f, fName, ts
    fName = "Windows Key.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateTextFile fName
    Set f = fso.GetFile(fName)
    Set f = f.OpenAsTextStream(ForWRITING, asASCII)
    f.Writeline Data
    f.Close
End Function

Key = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DefaultProductKey2\"
DigitalID = WshShell.RegRead(key & "DigitalProductId")
 
ProductID = "Product ID: " & WshShell.RegRead(Key & "ProductID") & vbNewLine
ProductKey = "Installed Key: " & ConvertToKey(DigitalID)
ProductID = ProductName & ProductID & ProductKey
 
If vbYes = MsgBox(ProductId & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "Windows Key Information") then
   Save1 ProductID
End if
 
Function ConvertToKey(Key)
    Const KeyOffset = 52
    isWin8 = (Key(66) \ 6) And 1
    Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
    i = 24
    Chars = "BCDFGHJKMPQRTVWXY2346789"
        Do
        Cur = 0
        X = 14
        Do
            Cur = Cur * 256
            Cur = Key(X + KeyOffset) + Cur
            Key(X + KeyOffset) = (Cur \ 24)
            Cur = Cur Mod 24
            X = X -1
        Loop While X >= 0
        i = i -1
        KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
        Last = Cur
    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
    a = Mid(KeyOutput, 1, 5)
    b = Mid(KeyOutput, 6, 5)
    c = Mid(KeyOutput, 11, 5)
    d = Mid(KeyOutput, 16, 5)
    e = Mid(KeyOutput, 21, 5)
    ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function
 
Function Save1(Data)
    Const ForWRITING = 2
    Const asASCII = 0
    Dim fso, f, fName, ts
    fName = "Windows Key 2.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateTextFile fName
    Set f = fso.GetFile(fName)
    Set f = f.OpenAsTextStream(ForWRITING, asASCII)
    f.Writeline Data
    f.Close
End Function

Key = "HKLM\SOFTWARE\Microsoft\Internet Explorer\Registration\"
DigitalID = WshShell.RegRead(key & "DigitalProductId")
 
'ProductName = "Product Name: " & WshShell.RegRead(Key & "ProductName") & vbNewLine
ProductID = "Product ID: " & WshShell.RegRead(Key & "ProductID") & vbNewLine
ProductKey = "Installed Key: " & ConvertToKey(DigitalID)
ProductID = ProductName & ProductID & ProductKey
 
If vbYes = MsgBox(ProductId & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "Windows Key Information") then
   Save2 ProductID
End if
 
Function ConvertToKey(Key)
    Const KeyOffset = 52
    isWin8 = (Key(66) \ 6) And 1
    Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
    i = 24
    Chars = "BCDFGHJKMPQRTVWXY2346789"
        Do
        Cur = 0
        X = 14
        Do
            Cur = Cur * 256
            Cur = Key(X + KeyOffset) + Cur
            Key(X + KeyOffset) = (Cur \ 24)
            Cur = Cur Mod 24
            X = X -1
        Loop While X >= 0
        i = i -1
        KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
        Last = Cur
    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
    a = Mid(KeyOutput, 1, 5)
    b = Mid(KeyOutput, 6, 5)
    c = Mid(KeyOutput, 11, 5)
    d = Mid(KeyOutput, 16, 5)
    e = Mid(KeyOutput, 21, 5)
    ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
End Function
 
Function Save2(Data)
    Const ForWRITING = 2
    Const asASCII = 0
    Dim fso, f, fName, ts
    fName = "Internet Explorer Key.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateTextFile fName
    Set f = fso.GetFile(fName)
    Set f = f.OpenAsTextStream(ForWRITING, asASCII)
    f.Writeline Data
    f.Close
End Function

Keys, Seriennummer in der Registry