Public Function sGetWinProductKey()
    Dim objShell, bDigitalProductID, bProductKey()
    Dim bKeyChars(24)
    Dim ilByte, nCur, sCDKey, ilKeyByte

    ReDim Preserve bProductKey(24)

    Set objShell = CreateObject("WScript.Shell")

    ' Windows 10 ve 11 için kayıt defteri yolu
    bDigitalProductID = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")

    Set objShell = Nothing

    ' Ürün anahtarını çıkarmak için gerekli baytları al
    For ilByte = 52 To 66
        bProductKey(ilByte - 52) = bDigitalProductID(ilByte)
    Next

    ' Anahtar karakterleri
    bKeyChars(0) = Asc("B")
    bKeyChars(1) = Asc("C")
    bKeyChars(2) = Asc("D")
    bKeyChars(3) = Asc("F")
    bKeyChars(4) = Asc("G")
    bKeyChars(5) = Asc("H")
    bKeyChars(6) = Asc("J")
    bKeyChars(7) = Asc("K")
    bKeyChars(8) = Asc("M")
    bKeyChars(9) = Asc("P")
    bKeyChars(10) = Asc("Q")
    bKeyChars(11) = Asc("R")
    bKeyChars(12) = Asc("T")
    bKeyChars(13) = Asc("V")
    bKeyChars(14) = Asc("W")
    bKeyChars(15) = Asc("X")
    bKeyChars(16) = Asc("Y")
    bKeyChars(17) = Asc("2")
    bKeyChars(18) = Asc("3")
    bKeyChars(19) = Asc("4")
    bKeyChars(20) = Asc("6")
    bKeyChars(21) = Asc("7")
    bKeyChars(22) = Asc("8")
    bKeyChars(23) = Asc("9")

    ' Anahtar oluşturma
    For ilByte = 24 To 0 Step -1
        nCur = 0
        For ilKeyByte = 14 To 0 Step -1
            nCur = nCur * 256 Xor bProductKey(ilKeyByte)
            bProductKey(ilKeyByte) = Int(nCur / 24)
            nCur = nCur Mod 24
        Next
        sCDKey = Chr(bKeyChars(nCur)) & sCDKey
        If ilByte Mod 5 = 0 And ilByte <> 0 Then sCDKey = "-" & sCDKey
    Next

    sGetWinProductKey = sCDKey
End Function

Public Function Question()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim Ans
    Dim desktopPath

    ' Kullanıcının masaüstü yolunu al
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

    Ans = MsgBox("Yes = Write Windows Product Key to the Desktop and No = Prompt with Product Key", 4)

    If Ans = vbYes Then
        Set oOutFile = objFSO.CreateTextFile(desktopPath & "\Windows_Product_Key.txt")
        oOutFile.WriteLine sGetWinProductKey
        oOutFile.Close
    Else
        WScript.Echo sGetWinProductKey
    End If
End Function

Call Question