For a software reinstallation program i'm making I would like to collect the current product key from Windows 7 and 8 so it can be automatically be re-used by my application.

Now I have found multiple examples but none of them seem to work...

I have tried below code but this always results in "N/A", the variable Hexbuf is empty but I don't understand why.

Public Function GetProductKey(ByVal KeyPath As String, ByVal ValueName As String) As String Dim HexBuf As Object = My.Computer.Registry.GetValue(KeyPath, ValueName, 0) If HexBuf Is Nothing Then Return "N/A" Dim tmp As String = "" For l As Integer = LBound(HexBuf) To UBound(HexBuf) tmp = tmp & " " & Hex(HexBuf(l)) Next Dim StartOffset As Integer = 52 Dim EndOffset As Integer = 67 Dim Digits(24) As String Digits(0) = "B" : Digits(1) = "C" : Digits(2) = "D" : Digits(3) = "F" Digits(4) = "G" : Digits(5) = "H" : Digits(6) = "J" : Digits(7) = "K" Digits(8) = "M" : Digits(9) = "P" : Digits(10) = "Q" : Digits(11) = "R" Digits(12) = "T" : Digits(13) = "V" : Digits(14) = "W" : Digits(15) = "X" Digits(16) = "Y" : Digits(17) = "2" : Digits(18) = "3" : Digits(19) = "4" Digits(20) = "6" : Digits(21) = "7" : Digits(22) = "8" : Digits(23) = "9" Dim dLen As Integer = 29 Dim sLen As Integer = 15 Dim HexDigitalPID(15) As String Dim Des(30) As String Dim tmp2 As String = "" For i = StartOffset To EndOffset HexDigitalPID(i - StartOffset) = HexBuf(i) tmp2 = tmp2 & " " & Hex(HexDigitalPID(i - StartOffset)) Next Dim KEYSTRING As String = "" For i As Integer = dLen - 1 To 0 Step -1 If ((i + 1) Mod 6) = 0 Then Des(i) = "-" KEYSTRING = KEYSTRING & "-" Else Dim HN As Integer = 0 For N As Integer = (sLen - 1) To 0 Step -1 Dim Value As Integer = ((HN * 2 ^ 8) Or HexDigitalPID(N)) HexDigitalPID(N) = Value \ 24 HN = (Value Mod 24) Next Des(i) = Digits(HN) KEYSTRING = KEYSTRING & Digits(HN) End If Next Return StrReverse(KEYSTRING) End Function

I also tried to use below code which is actually for Windows XP, this gives met the result "bbbbb-bbbbb-bbbbb-bbbbb-bbbbb"

Public Function sGetXPKey() As String Dim result As String = String.Empty Dim RegKey As RegistryKey = _ Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows NT\CurrentVersion", False) Dim bytDPID() As Byte = RegKey.GetValue("DigitalProductID") Dim bytKey(14) As Byte Array.Copy(bytDPID, 52, bytKey, 0, 15) Dim strChar As String = "BCDFGHJKMPQRTVWXY2346789" Dim strKey As String = "" For j As Integer = 0 To 24 Dim nCur As Short = 0 For i As Integer = 14 To 0 Step -1 nCur = CShort(nCur * 256 Xor bytKey(i)) bytKey(i) = CByte(Int(nCur / 24)) nCur = CShort(nCur Mod 24) Next strKey = strChar.Substring(nCur, 1) & strKey Next For i As Integer = 4 To 1 Step -1 strKey = strKey.Insert(i * 5, "-") Next Return strKeyEnd Function

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

Also checked on Windows 7 and 8 if the same registry key exists and it does so I can't think of any reason why the script is not working on Windows 7 and 8.

Please help

0

juriangAuthor Commented:

Anyone who could please help me in providing the code for Windows 7 and 8?

Your help would be very much appreciated.

0

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

http://www.magicaljellybean.com/keyfinder/

http://www.nirsoft.net/utils/product_cd_key_viewer.html