Lisanslı Windows 10'nu Sildim

[Leather53]

Arkadaşlar başlıktanda anlaşılcagı üzere Lisanslı Win7 den yükseltmeyle Win10 Home a geçiş yapmıştım.Otomatikmen Kendini Lisansladı.Lakin sıfırdan biçimlendirme yaparak Win10 pro yükledim haliyle lisanssız acaba eski lisansım silinmişmidir.Yani tekrardan win10 home kurarsam otomatik etkinleşirmi ne yapmam lazım.Key bilgilerini ayrı bir yere not almıştım duruyor.Hala geçerlimidir yoksa win10 pro kurduğum için gittimi tamamen ne yapmam lazım.Home a geçmek istiyorum Pro cok kasıyor ve lisans sıkıntısı var.

[MehmetYildiz]

8 saat önce, Leather53 yazdı:

Arkadaşlar başlıktanda anlaşılcagı üzere Lisanslı Win7 den yükseltmeyle Win10 Home a geçiş yapmıştım.Otomatikmen Kendini Lisansladı.Lakin sıfırdan biçimlendirme yaparak Win10 pro yükledim haliyle lisanssız acaba eski lisansım silinmişmidir.Yani tekrardan win10 home kurarsam otomatik etkinleşirmi ne yapmam lazım.Key bilgilerini ayrı bir yere not almıştım duruyor.Hala geçerlimidir yoksa win10 pro kurduğum için gittimi tamamen ne yapmam lazım.Home a geçmek istiyorum Pro cok kasıyor ve lisans sıkıntısı var.

Tekrardan Home sürümü yükleyip etkinleştirebilirsiniz.

[ozanaus]

Home sürümü sürümü yüklersen internete bağlandığı gibi otomatik etkinleşir

 

lisans yedekleme

altaki kodu bir metin belgesine yapıstırp farklı kaydek, uzantısını vbs yap

ornek lisansyedek.vbs

ardından calıstır lisansın bı yeree yedeklemıs olursun

 

 

Spoiler

 

' Düzenleyen: Nonpasaran
'
' İlgili makale:

Please register to see this content.

'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

 

Edited June 7, 2017 by ozanaus

[MrRush]

Yedek almasına gerek yok. 

Sen daha evvel Home sürüm kulandığın için tekrar onu kurmalısın. Pro için ayrı bir serial girmelisin. Home kurduğunda sistem internet üzerinden etkinleşir.

[Leather53]

sagolun arkadaşlar home sürümünü kurup bir deneyeceğim bakalım olacakmı.

[Leather53]

Arkadaşlar denedim oldu sorunsuzca kullanıyorum suan konuyu kilitleyebilirsiniz sagolun.