Как узнать ключ установленной Windows ! | Разработка игровых платформ
  1. Доброго времени суток. В связи с появлением спамеров, активация функций новых пользователей (Создавать темы, писать сообщения), теперь будет только после проверки администратором! Для регистрации отписываемся в лс, в вк. vk.com/tehnik777 (Пишем только с реальных страниц)
    Скрыть объявление

Как узнать ключ установленной Windows !

Тема в разделе "Рекомендации о ПК", создана пользователем Miron, 11 дек 2016.

Обсуждение темы Как узнать ключ установленной Windows ! в разделе Рекомендации о ПК на форуме zetta-forum.ru.

  1. Miron

    Miron Постоялец

    Регистрация:
    6 ноя 2016
    Сообщения:
    122
    Симпатии:
    29
    Баллы:
    28
    Пол:
    Мужской
    Скрипт:
    Код:
    Set WshShell = CreateObject("WScript.Shell")
    regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
    DigitalProductId = WshShell.RegRead(regKey & "DigitalProductId")
    Win8ProductName = "Windows Product Name: " & WshShell.RegRead(regKey & "ProductName") & vbNewLine
    Win8ProductID = "Windows Product ID: " & WshShell.RegRead(regKey & "ProductID") & vbNewLine
    Win8ProductKey = ConvertToKey(DigitalProductId)
    strProductKey ="Windows 8 Key: " & Win8ProductKey
    Win8ProductID = Win8ProductName & Win8ProductID & strProductKey
    MsgBox(Win8ProductKey)
    MsgBox(Win8ProductID)
    Function ConvertToKey(regKey)
    Const KeyOffset = 52
    isWin8 = (regKey(66) \ 6) And 1
    regKey(66) = (regKey(66) And &HF7) Or ((isWin8 And 2) * 4)
    j = 24
    Chars = "BCDFGHJKMPQRTVWXY2346789"
    Do
    Cur = 0
    y = 14
    Do
    Cur = Cur * 256
    Cur = regKey(y + KeyOffset) + Cur
    regKey(y + KeyOffset) = (Cur \ 24)
    Cur = Cur Mod 24
    y = y -1
    Loop While y >= 0
    j = j -1
    winKeyOutput = Mid(Chars, Cur + 1, 1) & winKeyOutput
    Last = Cur
    Loop While j >= 0
    If (isWin8 = 1) Then
    keypart1 = Mid(winKeyOutput, 2, Last)
    insert = "N"
    winKeyOutput = Replace(winKeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
    If Last = 0 Then winKeyOutput = insert & winKeyOutput
    End If
    a = Mid(winKeyOutput, 1, 5)
    b = Mid(winKeyOutput, 6, 5)
    c = Mid(winKeyOutput, 11, 5)
    d = Mid(winKeyOutput, 16, 5)
    e = Mid(winKeyOutput, 21, 5)
    ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
    End Function
     

    Вложения:

    • 1.jpg
      1.jpg
      Размер файла:
      69,9 КБ
      Просмотров:
      0
    • 2.jpg
      2.jpg
      Размер файла:
      51 КБ
      Просмотров:
      0
    Zloo нравится это.

Поделиться этой страницей