Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Set WshShell = CreateObject("WScript.Shell")
- MsgBox ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))
- FileLocation = GetCurrentFolder()
- call WriteToFIle(ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")),FileLocation)
- Function GetCurrentFolder()
- Dim FSO
- Set FSO = CreateObject("Scripting.FileSystemObject")
- GetCurrentFolder = FSO.GetAbsolutePathName(".")
- End Function
- Function WriteToFIle(prokey,File)
- '~ Create a FileSystemObject
- Set objFSO=CreateObject("Scripting.FileSystemObject")
- '~ Provide file path
- outFile=File
- '~ Setting up file to write
- Set objFile = objFSO.CreateTextFile(outFile&"/Productkey.txt",True)
- objFile.WriteLine prokey
- objFile.Close
- End Function
- Function ConvertToKey(Key)
- Const KeyOffset = 52
- i = 28
- Chars = "BCDFGHJKMPQRTVWXY2346789"
- Do
- Cur = 0
- x = 14
- Do
- Cur = Cur * 256
- Cur = Key(x + KeyOffset) + Cur
- Key(x + KeyOffset) = (Cur \ 24) And 255
- Cur = Cur Mod 24
- x = x -1
- Loop While x >= 0
- i = i -1
- KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
- If (((29 - i) Mod 6) = 0) And (i <> -1) Then
- i = i -1
- KeyOutput = "-" & KeyOutput
- End If
- Loop While i >= 0
- ConvertToKey = KeyOutput
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement