Script para identificar chave do Office. Testado e aprovado.

Segue o script que vale ouro. No caso abaixo ele da um Echo dos produtos Windows (confirmado e testado em XP e 2003), Office XP e Office 2007. Porem, caso tenha alguns produtos diferentes, da para colocar tambem. Para obter o Product Key, o script utiliza o DigitalProductID para o calculo.
Pode-se que a chave do seu Office seja diferente da encontrada em meu computador. Entao tera que trocar tb

No exemplo abaixo, a chave do Office 2007 é Office\12.0\Registration\{90120000-0021-0000-0000-0000000FF1CE}
Se a sua for diferente, deverá trocar.
Como tem On Error Resume Next, se tiver a chave errada nao vai dar erro, mas tambem nao vai aparecer. Pelo menos, o do Windows é garantido

----------------------------------------------------------------------------------------------------------------------------

Public Result

Pkey 1
Pkey 2
Pkey 3

WScript.Echo Result
Sub Pkey(btype)
On Error Resume Next

Dim bProduct
Dim bProductID
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")

Select Case btype
Case 1
bProduct = "Windows"
bDigitalProductID = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")
bProductID = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductId")
Case 2
bProduct = "Office XP"
bDigitalProductID = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration\{90520409-6000-11d3-8cfe-0150048383c9}\DigitalProductId")
bProductID = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\11.0\Registration\{90520409-6000-11d3-8cfe-0150048383c9}\ProductId")
Case 3
bProduct = "Office 2007"
bDigitalProductID = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\Registration\{90120000-0021-0000-0000-0000000FF1CE}\DigitalProductId")
bProductID = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\Registration\{90120000-0021-0000-0000-0000000FF1CE}\ProductId")
End Select
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

Result = Result & Chr(13) & bProduct & Chr(13) & sCDKey & Chr(13) & bProductID & Chr(13)

End Sub