Attain XP CD KEY ???

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Attain XP CD KEY ???

Logged in as: Guest

arrSession:exec spGetSession 2,2,2629

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> WSH & Client Side VBScript >> Attain XP CD KEY ???
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Attain XP CD KEY ??? - 4/9/2005 8:31:31 AM

gecko2648

Posts: 1
Score: 0
Joined: 4/9/2005
From:
Status: offline

ok I have this code in visual basic 6.0 :

'========================================================

'**************************************
'Windows API/Global Declarations for :View Windows XP CD Key
'**************************************
Option Explicit

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Const REG_BINARY = 3
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&

Public Function sGetXPCDKey() As String
'Read the value of:
'HKLM\SOFTWARE\MICROSOFT\Windows NT\Curr
' entVersion\DigitalProductId
Dim bDigitalProductID() As Byte
Dim bProductKey() As Byte
Dim ilByte As Long
Dim lDataLen As Long
Dim hKey As Long
'Open the registry key: HKLM\SOFTWARE\MI
' CROSOFT\Windows NT\CurrentVersion

If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", hKey) = ERROR_SUCCESS Then
lDataLen = 164
ReDim Preserve bDigitalProductID(lDataLen)
'Read the value of DigitalProductID

If RegQueryValueEx(hKey, "DigitalProductId", 0&, REG_BINARY, bDigitalProductID(0), lDataLen) = ERROR_SUCCESS Then
'Get the Product Key, 15 bytes long, off
' set by 52 bytes
ReDim Preserve bProductKey(14)

For ilByte = 52 To 66
bProductKey(ilByte - 52) = bDigitalProductID(ilByte)
Next ilByte
Else
'ERROR: Could not read "DigitalProductID
' "
sGetXPCDKey = ""
Exit Function
End If
Else
'ERROR: Could not open "HKLM\SOFTWARE\MI
' CROSOFT\Windows NT\CurrentVersion"
sGetXPCDKey = ""
Exit Function
End If
'Now we are going to 'base24' decode the
' Product Key
Dim bKeyChars(0 To 24) As Byte
'Possible characters in the CD Key:
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")
Dim nCur As Integer
Dim sCDKey As String
Dim ilKeyByte As Long
Dim ilBit As Long

For ilByte = 24 To 0 Step -1
'Step through each character in the CD k
' ey
nCur = 0

For ilKeyByte = 14 To 0 Step -1
'Step through each byte in the Product K
' ey
nCur = nCur * 256 Xor bProductKey(ilKeyByte)
bProductKey(ilKeyByte) = Int(nCur / 24)
nCur = nCur Mod 24
Next ilKeyByte
sCDKey = Chr(bKeyChars(nCur)) & sCDKey
If ilByte Mod 5 = 0 And ilByte <> 0 Then sCDKey = "-" & sCDKey
Next ilByte
sGetXPCDKey = sCDKey
End Function

'============================

Is there anyone out there who could convert it into vbscript for me or alter it so that it would work in vbscript.

Thank you so much for your time and effort in helping me in advance !!

Kind regards

Gecko[}:)]

< Message edited by Snipah -- 10/29/2005 2:36:28 AM >

Post #: 1

Re: Attain XP CD KEY ??? - 4/9/2005 12:04:22 PM

token

Posts: 1917
Score: 0
Joined: 1/14/2005
From:
Status: offline

What exactly do you intend to do with this script ?

(in reply to gecko2648)

Post #: 2

RE: Re: Attain XP CD KEY ??? - 10/28/2005 10:42:31 PM

POD64

Posts: 23
Score: 0
Joined: 10/25/2005
Status: offline

I guess

quote:

'**************************************
'Windows API/Global Declarations for :View Windows XP CD Key
'**************************************

(in reply to token)

Post #: 3

RE: Attain XP CD KEY ??? - 10/29/2005 2:32:35 AM

Snipah

Posts: 1343
Score: 6
Joined: 11/1/2004
From: Netherlands
Status: offline

Gecko2648,

'----------------------------------------

Public Function sGetXPCDKey()

Dim bDigitalProductID
   Dim bProductKey()
   Dim bKeyChars(24)
   Dim ilByte
   Dim nCur
   Dim sCDKey
   Dim ilKeyByte
   Dim ilBit
      
   ReDim Preserve bProductKey(14)
   
   Set objShell = CreateObject("WScript.Shell")
   
   bDigitalProductID = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion\DigitalProductId")

Set objShell = Nothing

For ilByte = 52 To 66
     bProductKey(ilByte - 52) = bDigitalProductID(ilByte)
   Next
 
   'Possible characters in the CD Key[/b]:
   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")

For ilByte = 24 To 0 Step -1
     
     nCur = 0

For ilKeyByte = 14 To 0 Step -1
       'Step through each byte in the Product Key[/b]
       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
  
   sGetXPCDKey = sCDKey
    
   
End Function

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

Ans = MsgBox("Yes = Write Windows XP [/b]Serial [/b]key[/b] to the C Drive and No = Prompt with Serial [/b]key[/b]",4)

If Ans = vbYes then

Set oOutFile = objFSO.CreateTextFile("c:\XP_Serial_Key.txt")

oOutFile.WriteLine sGetXPCDKey
else
wscript.echo sGetXPCDKey
End If
End Function

call Question

'----------------------------------

_____________________________

For more information, please see the "Read me First" topic.

http://www.visualbasicscript.com

(in reply to gecko2648)

Post #: 4

If you found our site useful please link to us <a href="http://www.visualbasicscript.com">VisualBasicScript.com</a>.

All Forums >> [Scripting] >> WSH & Client Side VBScript >> Attain XP CD KEY ???

Page: [1]

Jump to:

New Messages	No New Messages
Hot Topic w/ New Messages	Hot Topic w/o New Messages
Locked w/ New Messages	Locked w/o New Messages

Post New Thread

Reply to Message

Post New Poll

Submit Vote

Delete My Own Post

Delete My Own Thread

Rate Posts