• Kazandığınız her 1000 ÇTL birikiminizi 5 TL ile değiştirip ödeme alabilirsiniz...
Kaynak ikonu

Windows Ürün Anahtarı Bulma 2019-09-02

Bu vbs kodları ile ürün anahtarınızı rahatlıkla bulabilirsiniz. İsterseniz aşağıdaki kodları kopyalayıp bir isim verin ve .vbs uzantısı ile kaydedip çalıştırın, isterseniz indirme butonuna tıklayarak ilgili dosyayı indirip alıştırın.

Birkaç saniye sonra size bilgisayarınızın ürün anahtarını verecektir. Anahtarı text dosyaya kaydetme seçeneği sunulmaktadır.

Windows ürün nahtarı bulma


Ürün anahtarı bulmak için .vbs kodları

Kod:
'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 ister misin?", vbYesNo + vbInformation, "Windows Key - CerezForum.com") 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 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

Not: Bunun için çok yaygın şekilde kullanılan ProduKey adlı programı da kullanabilirsiniz. ProduKey indirme linkine BURADAN ulaşabilirsiniz.
Gönderen
YoRuMSuZ
İndirilme
4
Gösterim
29
İlk yayınlama
Son güncelleme
Değerlendirme
0.00 star(s) 0 oy

YoRuMSuZ ait diğer kaynakar

Top