Ana sayfa İnternet Windows 10 Ürün Anahtarını Görüntülemek

Windows 10 Ürün Anahtarını Görüntülemek

3
PAYLAŞ

Bu yazımızda lisanlı Windows 7, 8 ve 8.1 kullanıcılarına yayınlanan Wİndows 10 sürümünde daha önce satın aldığınız yada korsan ürün olmadığını tasdik eden Windows 10 ürün anahtarı öğrenme için hangi adımları izleyeceğinizi göstereceğiz

Öncelikle Microsoft tarafından yayınlanan kodları yazmak için bir adet not defteri açıyoruz

Birçok forumda ve blog da bulacağınız kodu defteri açıp yapıştırıyoruz.

catsasdasda


 

Option Explicit

Dim objshell,path,DigitalID, Result
Set objshell = CreateObject(WScript.Shell)
‘Set registry key path
Path = HKLMSOFTWAREMicrosoftWindows NTCurrentVersion
‘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
keypart1 = Mid(KeyOutput, 2, Last)
insert = N
KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
If Last = 0 Then KeyOutput = insert & KeyOutput
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 = CUsers & UserName & DesktopWindowsKeyInfo.txt
Set fso = CreateObject(Scripting.FileSystemObject)
Set txt = fso.CreateTextFile(fName)
txt.Writeline Data
txt.Close
End Function

Yazımızı yapıştırıp dosya yazısına tıklıyoruz ve farklı kaydet diyoruz.

catsAFSAGFarklı kaydet menüsünde açılan alana ise dosya ismini BackupWindowsKey.vbs yapın.

Kayıt türünü ise tüm dosyalar olarak ayarlayın.

catszxczxcKaydet dedikten sonra oluşan dosyaya çift tıklayarak Windows 10 ürün anahtarınızı öğrenebilirsiniz.

[Toplam:0    Ortalama:0/5]