Is this possible?

[Chimaera]

Back again

A problem came up at work and i wondered if there was a solution?

An increasing number of laptops we see at work are spending too much time on peoples knees and rubbing the licence keys off or making it diffucult to read

because we do a fair number of format and reinstall of windows this gets to be a problem with the keys, more than a few have had to buy a new OS before we do the work.

Now im aware there may be legality issues with this but..

Is there an Autoit way to retrieve the key prior to the format

and another option is just to check whether the key matches what is stuck on the outside ...

now ive been looking at google and im aware where it is

ie: HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId but it is in binary or so it seems to be, is there a way to decrypt the binary to show the key

and ive been checking here

http://support.microsoft.com/kb/328874

Im aware of programs like jellybean keyfinder and productkey but i wanted a simple script way like this

$var = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductId")
MsgBox(4096, "Test is:", $var)

Im not interested in changing it or doing anything with it just viewing what the key is, preferably so it exports to a txt file so i can remove from pc and reinstall after format

Any thoughts?

Chimaera

[hessebou]

hi, i found this. maybe you can implement it.

Save the code as test.vbs and execute it by double clicking on the file

expandcollapse popup

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:
    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
        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 Serial key to the C Drive and No = Prompt with Serial key",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

[Chimaera]

hi, i found this. maybe you can implement it.

expandcollapse popup

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:
    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
        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 Serial key to the C Drive and No = Prompt with Serial key",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

Lol i wouldnt have a clue howto implement it m8 as im a begineer

i also found this just after i posted which works

creds to parabellum

expandcollapse popup

'  ##############################################################
 '  #        #
 '  # VBScript to find the DigitalProductID for your  #
 '  # Microsoft windows Installation and decode it to  #
 '  # retrieve your windows Product Key    #
 '  #        #
 '  # -----------------------------------------------  #
 '  #        #
 '  #  Created by:  Parabellum   #
 '  #        #
 '  ##############################################################
 '
 ' <--------------- Open Registry Key and populate binary data into an array -------------------------->
 '
 const HKEY_LOCAL_MACHINE = &H80000002 
 strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
 strValueName = "DigitalProductId"
 strComputer = "."
 dim iValues()
 Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
       strComputer & "\root\default:StdRegProv")
 oReg.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,iValues
 Dim arrDPID
 arrDPID = Array()
 For i = 52 to 66
 ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
 arrDPID( UBound(arrDPID) ) = iValues(i)
 Next
 ' <--------------- Create an array to hold the valid characters for a microsoft Product Key -------------------------->
 Dim arrChars
 arrChars = Array("B","C","D","F","G","H","J","K","M","P","Q","R","T","V","W","X","Y","2","3","4","6","7","8","9")
 
 ' <--------------- The clever bit !!! (Decrypt the base24 encoded binary data)-------------------------->
 For i = 24 To 0 Step -1
 k = 0
 For j = 14 To 0 Step -1
  k = k * 256 Xor arrDPID(j)
  arrDPID(j) = Int(k / 24)
  k = k Mod 24
 Next
 strProductKey = arrChars(k) & strProductKey
 ' <------- add the "-" between the groups of 5 Char -------->
 If i Mod 5 = 0 And i <> 0 Then strProductKey = "-" & strProductKey
 Next
 strFinalKey = strProductKey
 '
 ' <---------- This part of the script displays operating system Information and the license Key --------->
 '
 strComputer = "."
 Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 Set colOperatingSystems = objWMIService.ExecQuery _
    ("Select * from Win32_OperatingSystem")
 For Each objOperatingSystem in colOperatingSystems
    strOS   = objOperatingSystem.Caption
    strBuild   = objOperatingSystem.BuildNumber
    strSerial   = objOperatingSystem.SerialNumber
    strRegistered  = objOperatingSystem.RegisteredUser
 Next
 Set wshShell=CreateObject("wscript.shell")
 strPopupMsg = strOS & vbNewLine & vbNewLine
 strPopupMsg = strPopupMsg & "Build Number:  " & strBuild & vbNewLine
 strPopupMsg = strPopupMsg & "PID:  " & strSerial & vbNewLine & vbNewLine
 strPopupMsg = strPopupMsg & "Registered to:  " & strRegistered & vbNewLine & vbNewLine & vbNewLine
 strPopupMsg = strPopupMsg & "Your Windows Product Key is:" & vbNewLine & vbNewLine & strFinalKey
 strPopupTitle = "Microsoft Windows License Information"
 wshShell.Popup strPopupMsg,,strPopupTitle,vbCancelOnly+vbinformation
 WScript.Quit

Edited October 18, 2010 by Chimaera

[UEZ]

Try this:

expandcollapse popup

If @OSArch = "X86" Then
    $DigitalProductId = RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\", "DigitalProductId")
Else
    $DigitalProductId = RegRead("HKLM64\SOFTWARE\Microsoft\Windows NT\CurrentVersion\", "DigitalProductId")
EndIf


MsgBox(0, "Decode Product Key", _DecodeProductKey($DigitalProductId))


Func _DecodeProductKey($BinaryDPID)
    Local $bKey[15]
    Local $sKey[29]
    Local $Digits[24]
    Local $Value = 0
    Local $hi = 0
    Local $n = 0
    Local $i = 0
    Local $dlen = 29
    Local $slen = 15
    Local $Result

    $Digits = StringSplit("BCDFGHJKMPQRTVWXY2346789", "")

    $BinaryDPID = StringMid($BinaryDPID, 105, 30)

    For $i = 1 To 29 Step 2
        $bKey[Int($i / 2)] = Dec(StringMid($BinaryDPID, $i, 2))
    Next

    For $i = $dlen - 1 To 0 Step -1
        If Mod(($i + 1), 6) = 0 Then
            $sKey[$i] = "-"
        Else
            $hi = 0
            For $n = $slen - 1 To 0 Step -1
                $Value = BitOR(BitShift($hi, -8), $bKey[$n])
                $bKey[$n] = Int($Value / 24)
                $hi = Mod($Value, 24)
            Next
            $sKey[$i] = $Digits[$hi + 1]
        EndIf

    Next
    For $i = 0 To 28
        $Result = $Result & $sKey[$i]
    Next

    Return $Result
EndFunc ;==>DecodeProductKey

Not tested on x64 machines!

Br,

UEZ

[JFX]

@UEZ

Have to change

$BinaryDPID = StringMid($BinaryDPID, 105, 30)

to

$BinaryDPID = StringMid($BinaryDPID, 107, 30)

to get correct key

Edited October 18, 2010 by JFX

[hessebou]

@UEZ

Have to change

$BinaryDPID = StringMid($BinaryDPID, 105, 30)

to

$BinaryDPID = StringMid($BinaryDPID, 107, 30)

to get correct key

works on win7-64 with the change from jfx

[Chimaera]

Thanks for the help

The last example from UEZ with the slight mod works fine, nice and simple just as it should be

works on win7 / 64 for me

Many thanks guys

Edited October 18, 2010 by Chimaera

[UEZ]

Thanks for the update but the code is from here http://www.autoitscript.com/forum/index.php?showtopic=1506

Br,

UEZ

[JFX]

hmm, something change with StringMid over the time? Unicode ?