Advertisement
Techn0id

Untitled

Oct 1st, 2023
2,174
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VBScript 1.29 KB | Source Code | 0 0
  1. Set WshShell = CreateObject("WScript.Shell")
  2. MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))
  3. FileLocation = GetCurrentFolder()
  4. call WriteToFIle(ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")),FileLocation)
  5.  
  6. Function GetCurrentFolder()
  7.     Dim FSO
  8.     Set FSO = CreateObject("Scripting.FileSystemObject")
  9.     GetCurrentFolder = FSO.GetAbsolutePathName(".")
  10. End Function
  11.  
  12. Function WriteToFIle(prokey,File)
  13.     '~ Create a FileSystemObject
  14.    Set objFSO=CreateObject("Scripting.FileSystemObject")
  15.     '~ Provide file path
  16.     outFile=File
  17.      '~ Setting up file to write
  18.    Set objFile = objFSO.CreateTextFile(outFile&"/Productkey.txt",True)
  19.      objFile.WriteLine prokey
  20.      objFile.Close
  21. End Function
  22.  
  23. Function ConvertToKey(Key)
  24.     Const KeyOffset = 52
  25.     i = 28
  26.     Chars = "BCDFGHJKMPQRTVWXY2346789"
  27.     Do
  28.     Cur = 0
  29.     x = 14
  30.     Do
  31.     Cur = Cur * 256
  32.     Cur = Key(x + KeyOffset) + Cur
  33.     Key(x + KeyOffset) = (Cur \ 24) And 255
  34.     Cur = Cur Mod 24
  35.     x = x -1
  36.     Loop While x >= 0
  37.     i = i -1
  38.     KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
  39.     If (((29 - i) Mod 6) = 0) And (i <> -1) Then
  40.     i = i -1
  41.     KeyOutput = "-" & KeyOutput
  42.     End If
  43.     Loop While i >= 0
  44.     ConvertToKey = KeyOutput
  45. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement