windows yüklü gelen pc' de lisans anahtarı bulma

indir çalıştır yazdır.

https://drive.google.com/uc?export=download&id=0Bx8GhELEGSIUT0xSQ0tvb21QMXc

Oem dediği bilgisayara gömülü olan windows sürümünün anahtarı.
Geçerli dediği, eğer yükseltme yaptıysan.

http://8.enpedi.com/2014/08/windows-8-ve-81-lisans-anahtarn-bulmak.html

Eğer indirme linki çalışmadı ise aşağıdaki kodu text ile yazıp uzantısını uzantısını .vbs yaptıktan sonra Windows Microsoft Based script host ile farklı çalıştır.



'Option Explicit
On Error Resume Next
Dim OEM , objWMIService , colItems , objItem , verItems, ver , name
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2") 
Set verItems = objWMIService.ExecQuery( _
    "SELECT * FROM Win32_OperatingSystem",,48) 
For Each objItem in verItems 
ver = objItem.Version
name = Replace (objItem.Caption,"Microsoft ","")
Next

Set colItems = objWMIService.ExecQuery( _
    "SELECT * FROM SoftwareLicensingService",,48) 
For Each objItem in colItems 
    OEM = objItem.OA3xOriginalProductKey
Next
If OEM = "" Then 
If CLng(Replace(ver,".","")) < 630000 Then
OEM = Ad & " Desteklenmiyor"
Else
OEM = "Anahtar BIOS'da bulunamadı"
End If
End If

Set WshShell = CreateObject("WScript.Shell")
Key = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
DigitalID = WshShell.RegRead(key & "DigitalProductId")

ProductName = "İşletim sistemi sürümü: " & vbTab & WshShell.RegRead(Key & "ProductName") & vbNewLine
ProductID = "Ürün Kimliği: " & vbTab & WshShell.RegRead(Key & "ProductID") & vbNewLine
ProductKey = "Geçerli Anahtar: " & vbTab & ConvertToKey(DigitalID)
Product = ProductName & ProductID & ProductKey & vbNewLine & "OEM Anahtar:   " & vbTab & OEM


If vbYes = MsgBox(Product & vbNewLine & vbNewLine & vbNewLine & vbNewLine & "Kaydetmek istiyor musunuz?", vbYesNo + vbInformation, "Lisans Anahtarımı göster! by Nonpasaran") then
   Save Product
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 Lisans anahtarı.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