none
Como identificar qual foi o serial utilizado na instalação do Office 2007 e Windows Vista e 2003?

    Pergunta

  • Pessoal, preciso fazer um levantamento de licenças utilizadas na empresa onde trabalho e para tanto preciso saber o número de offices e windows instalados com determinados seriais.
    Tudo o que consegui até agora são scripts que listam os softwares e S.O.'s instalados e trazem algumas informações tal como product id.
    Existe algum meio de saber se o serial que tenho em mãos foi utilizado numa determinada estação tendo em mãos o product id ou há alguma outra forma?

    Grato!
    terça-feira, 11 de agosto de 2009 12:01

Respostas

  • 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


                         

    • Marcado como Resposta Edson Gonçalves quinta-feira, 13 de agosto de 2009 15:16
    quinta-feira, 13 de agosto de 2009 09:34

Todas as Respostas

  • Olá,

    Tente utilizar o software newt professional:

    http://www.baixaki.com.br/download/newt-professional.htm

    Com ele você consegue free (até 25 maquinas) fazer um inventário da rede (incluindo os seriais do S.O e do office)

    Verifique se te atende e nos retorne.


    Até mais,

    Jesiel

    Obs.: Se útil, classifique


    terça-feira, 11 de agosto de 2009 13:42
  • Jesiel.

    Está é uma ótima ferramenta, traz muitas informações e possibilita exportar para excel.
    O problema é que não tenho tempo hábil para aprovação deste investimento e por isso um script seria mais viavél para a minha atual necessidade.

    Grato,
    Edson Gonçalves.
    terça-feira, 11 de agosto de 2009 16:25
  • 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


                         

    • Marcado como Resposta Edson Gonçalves quinta-feira, 13 de agosto de 2009 15:16
    quinta-feira, 13 de agosto de 2009 09:34
  • 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


                         


    Angelo.

    Testei e para o windows funcionou de fato, vou fazer as alterações que você citou em relação ao office e lhe dou retorno.

    Obrigado por enquanto!
    quinta-feira, 13 de agosto de 2009 13:06
  • 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


                         


    Angelo.

    Testei e para o windows funcionou de fato, vou fazer as alterações que você citou em relação ao office e lhe dou retorno.

    Obrigado por enquanto.


    Funcionou com a alteração do caminho conforme você falou.


    Muito obrigado!
    quinta-feira, 13 de agosto de 2009 15:15
  • Boa Tarde,

    Desculpa desenterrar o topico mas precisava de uma ajuda.

    Teria como mostrar os resultados em um único html?

    Alguem poderia me mostrar como?

    Muito Obrigado!

    segunda-feira, 13 de fevereiro de 2012 20:27
  • Tenta este cod, ele é um HTA, copie e cole no Notepad e salve com a extensão .hta

    vc pode exporta tanto pra Html, txt, xls ou csv

    <HTML> <HTA:APPLICATION APPLICATIONNAME="Chave do Produto" ID="KeyViewer" VERSION="v1.1" BORDERSTYLE="DOUBLE" BORDER="yes" SCROLLING="yes" NAVIGABLE="yes" ICON="C:\Windows\system32\PerfCenterCpl.ico"/> <title>Chave do Produto</title> <style type="text/css"> body {background-color:#F8F8FF; font-family:Calibri; } .Button {color: #000000;font-weight: 1px;border: 1px outset #FFFFFF;font-face:VERDANA; font-weight:bold;.filter:progid:DXImageTransform.Microsoft.Gradient(startColorStr='#F8F8FF',endColorStr='#DCDCDC',gradientType='0');} </style> <script language="VBScript"> Const HKEY_LOCAL_MACHINE = &H80000002 Dim strComputer, iTimerID, strExport Dim arrKeys() Set objShell = CreateObject("Wscript.Shell") Set objFSO = CreateObject("Scripting.FileSystemObject") strTemp = objShell.ExpandEnvironmentStrings("%TEMP%") Sub CheckPC() If IsNull(txtComputerName.Value) OR txtComputerName.Value = "" OR txtComputerName.Value = "." Then txtComputerName.Value = objShell.ExpandEnvironmentStrings("%COMPUTERNAME%") End If txtComputerName.Value = UCase(txtComputerName.Value) strComputer = txtComputerName.Value DataArea.InnerHTML = "<span style=""font-weight:bold"">Aguarde Por Favor...</span>" iTimerID = window.setInterval("GetProductKeys", 1) End Sub Sub GetProductKeys() On Error Resume Next strExport = "" intKey = 0 window.clearInterval(iTimerID) strWinVer = CheckWinArchitecture() If IsNull(strWinVer) OR strWinVer = "" Then strWinVer = "32-bit" Erase arrKeys Dim arrMSSubKeys(6,1) Select Case strWinVer Case "64-bit" arrMSSubKeys(1,0) = "Microsoft Office 2003" arrMSSubKeys(1,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\11.0\Registration" arrMSSubKeys(2,0) = "Microsoft Office XP" arrMSSubKeys(2,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\10.0\Registration" arrMSSubKeys(3,0) = "Microsoft Office 2007" arrMSSubKeys(3,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\12.0\Registration" arrMSSubKeys(4,0) = "Microsoft Office 2010" arrMSSubKeys(4,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\14.0\Registration" Case Else arrMSSubKeys(1,0) = "Microsoft Office 2003" arrMSSubKeys(1,1) = "SOFTWARE\Microsoft\Office\11.0\Registration" arrMSSubKeys(2,0) = "Microsoft Office XP" arrMSSubKeys(2,1) = "SOFTWARE\Microsoft\Office\10.0\Registration" arrMSSubKeys(3,0) = "Microsoft Office 2007" arrMSSubKeys(3,1) = "SOFTWARE\Microsoft\Office\12.0\Registration" arrMSSubKeys(4,0) = "Microsoft Office 2010" arrMSSubKeys(4,1) = "SOFTWARE\Microsoft\Office\14.0\Registration" End Select arrMSSubKeys(0,0) = "Microsoft Windows Chaves do Produto" arrMSSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion" arrMSSubKeys(5,0) = "Microsoft Exchange Chaves do Produto" arrMSSubKeys(5,1) = "SOFTWARE\Microsoft\Exchange\Setup" strValueName = "DigitalProductID" Err.Clear Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ strComputer & "\root\default:StdRegProv") Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ strComputer & "\root\cimv2") For i = 0 to 5 Select Case i Case 0 strProduct = "Microsoft Windows" Case 5 strProduct = "Microsoft Exchange" End Select objReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrMSSubKeys(i,1), _ strValueName, strValue If Not IsNull(strValue) Then If i = 0 Then strMicrosoft = "<tr><th colspan=3 style=""text-align:left;"">Microsoft</th></tr>" Set colOS = objWMIService.ExecQuery _ ("Select * from Win32_OperatingSystem") For Each objItem In colOS strOS = objItem.Caption Next If IsNull(strOS) OR strOS = "" Then strOS = "Windows OS" intKey = intKey + 1 ReDim Preserve arrKeys(intKey) arrKeys(intKey) = DecodeMSKey(strValue) strExport = strExport & strOS & "||" & arrKeys(intKey) & "|||" strMicrosoft = strMicrosoft & "<tr><td>" & strOS & "</td>" & _ "<td style=""font-family:'calibri'"">" & arrKeys(intKey) & _ "</td><td><Left><input id=""RunButton"" class=""Button"" type=""button"" " & _ "value=""Copiar Chave"" name=""btnCopyProdKey"" onclick=""CopyKeyInfo(" & intKey & ")"" " & _ "title=""Efetua a Cópia da chave para área de transferência""></td></tr>" Else intKey = intKey + 1 ReDim Preserve arrKeys(intKey) arrKeys(intKey) = DecodeMSKey(strValue) strExport = strExport & arrMSSubKeys(i,0) & "||" & arrKeys(intKey) & "|||" strMicrosoft = strMicrosoft & "<tr><td>" & arrMSSubKeys(i,0) & "</td>" & _ "<td style=""font-family:'calibri';"">" & arrKeys(intKey) & _ "</td><td><input id=""RunButton"" class=""Button"" type=""button"" " & _ "value=""Copiar Chave"" name=""btnCopyProdKey"" onclick=""CopyKeyInfo(" & intKey & ")"" " & _ "title=""Efetua a Cópia da chave para área de transferência""</td></tr>" End If Else objReg.EnumKey HKEY_LOCAL_MACHINE, arrMSSubKeys(i,1), arrGUIDKeys If Not IsNull(arrGUIDKeys) Then For Each strSubKey In arrGUIDKeys objReg.GetBinaryValue HKEY_LOCAL_MACHINE, _ arrMSSubKeys(i,1) & "\" & strSubKey, strValueName, strValue objReg.GetStringValue HKEY_LOCAL_MACHINE, arrMSSubKeys(i,1) & "\" & strSubKey, "ProductName", strProduct If Not IsNull(strValue) Then intKey = intKey + 1 ReDim Preserve arrKeys(intKey) arrKeys(intKey) = DecodeMSKey(strValue) strExport = strExport & strProduct & "||" & arrKeys(intKey) & "|||" strMicrosoft = strMicrosoft & "<tr><td>" & strProduct & "</td>" & _ "<td style=""font-family:'calibri'"">" & arrKeys(intKey) & _ "</td><td><input id=""RunButton"" class=""Button"" type=""button"" " & _ "value=""Copiar Chave"" name=""btnCopyProdKey"" onclick=""CopyKeyInfo(" & intKey & ")"" " & _ "title=""Efetua a Cópia da chave para área de transferência""</td></tr>" End If Next End If End If Next '#-------------------------------------------------------------------------- '# Exportação '#-------------------------------------------------------------------------- strHTML = "<div style=""overflow:auto;border:1px solid #a5a5a5;" & _ "padding:0px;margin: 0px"">" strHTML = strHTML & "<table width=90%>" strHTML = strHTML & strMicrosoft strHTML = strHTML & "</table></div>" strHTML = strHTML & "<div style=""text-align:right;"">" strHTML = strHTML & "<select name=""ProdKeyExport"" " & _ "title=""Selecione o formato desejado"" onChange=""ExportProdKeys()"">" strHTML = strHTML & "<option value=""0"">Exportar para:</option>" strHTML = strHTML & "<option value=""1"" title=""Exporta a chave para CSV " & _ "Valores separados (CSV)"")>Exportar para csv</option>" strHTML = strHTML & "<option value=""2"" title=""Exporta a chave para Excel " & _ "Planilha(xls)"">Exportar para xls</option>" strHTML = strHTML & "<option value=""3"" title=""Exporta a chave para a Web " & _ "página de html"">Exportar para html</option>" strHTML = strHTML & "<option value=""4"" title=""Exporta a chave para Texto " & _ "Arquivo TXT"">Exportar para txt</option>" strHTML = strHTML & "</select></div>" DataArea.InnerHTML = strHTML End Sub '#Cod para copiar para área de transferencia Sub CopyKeyInfo(intKey) strCopy = arrKeys(intKey) document.parentwindow.clipboardData.SetData "text", strCopy MsgBox "Copiado para a área de transferência !", vbInformation, "Chaves do Produto" End Sub '# Cod para exportar para csv / xls / html / txt Sub ExportProdKeys() On Error Resume Next Select Case ProdKeyExport.Value Case 1 Set objFile = objFSO.CreateTextFile(strTemp & "\ProdKeys" & strComputer & ".csv",True) objFile.WriteLine "Chaves de " & strComputer objFile.WriteLine "" objFile.WriteLine "Produto,Chave do Produto" Case 2 Const xlContinuous = 1 Const xlThin = 2 Const xlAutomatic = -4105 strExcelPath = objShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\excel.exe\") If strExcelPath = "" Then MsgBox "Não é possível exportar. Excel não estar instalado.", vbExclamation, "Chaves do Produto" Exit Sub End If Set objExcel = CreateObject("Excel.Application") objExcel.Visible = False Set objWorkBook = objExcel.WorkBooks.Add Set objWorksheet = objWorkbook.Worksheets(1) objExcel.DisplayAlerts = False For i = 1 to 3 objWorkbook.Worksheets(2).Delete Next objExcel.DisplayAlerts = True objWorksheet.Name = "Chave do Produto" objWorkSheet.Cells(1, 1) = "Chaves de " & strComputer intStartRow = 4 objWorkSheet.Cells(3, 1) = "Produto" objWorkSheet.Cells(3, 2) = "Chave do Produto" Case 3 Set objFile = objFSO.CreateTextFile(strTemp & "\ProdKeys" & strComputer & ".htm",True) objFile.WriteLine "<style type=""text/css"">" objFile.WriteLine "body{background-color:#CEF0FF;}" objFile.WriteLine "table.export{border-width:1px;border-spacing:1px;border-style:solid;border-color:gray;border-collapse:collapse;}" objFile.WriteLine "table.export th{border-width:1px;padding:1px;border-style:solid;border-color:gray;padding:2px 7px 2px 7px;}" objFile.WriteLine "table.export td{border-width:1px;padding:1px;border-style:dotted;border-color:gray;padding:2px 7px 2px 7px;}" objFile.WriteLine "</style>" objFile.WriteLine "<div style=""font-weight:bold;""><a name =""top"">Chaves de " & _ strComputer & "</a><p>" objFile.WriteLine "</div>" objFile.WriteLine "<table class=""export"">" objFile.WriteLine " <tr>" objFile.WriteLine " <th style=""text-align:left;"">" objFile.WriteLine " Produto" objFile.WriteLine " </th>" objFile.WriteLine " <th style=""text-align:left;"">" objFile.WriteLine " Chave do Produto" objFile.WriteLine " </th>" objFile.WriteLine " </tr>" Case 4 intColumnIndex = 12 arrExport = Split(strExport, "|||") For i = 0 to UBound(arrExport) arrProduct = Split(arrExport(i), "||") strProduct = arrProduct(0) If Len(strProduct) + 5 > intColumnIndex Then intColumnIndex = Len(strProduct) + 5 Next Set objFile = objFSO.CreateTextFile(strTemp & "\ProdKeys" & strComputer & ".txt",True) objFile.WriteLine "Chaves de " & strComputer objFile.WriteLine "" objFile.WriteLine "Produto" & String(intColumnIndex - 7, " ") & "Chaves do Produto" End Select arrExport = Split(strExport, "|||") If ProdKeyExport.Value = 1 Then strExport = Replace(strExport, ",", ".") End If Select Case ProdKeyExport.Value Case 1 For i = 0 to UBound(arrExport) - 1 arrProduct = Split(arrExport(i), "||") strProduct = arrProduct(0) strKey = arrProduct(1) strCSV = strCSV & strProduct & "," & _ strKey & vbCrLf Next Case 2 For i = 0 to UBound(arrExport) - 1 arrProduct = Split(arrExport(i), "||") strProduct = arrProduct(0) strKey = arrProduct(1) objWorkSheet.Cells(intStartRow, 1) = strProduct objWorkSheet.Cells(intStartRow, 2) = strKey intStartRow = intStartRow + 1 Next Case 3 For i = 0 to UBound(arrExport) - 1 arrProduct = Split(arrExport(i), "||") strProduct = arrProduct(0) strKey = arrProduct(1) objFile.WriteLine " <tr>" objFile.WriteLine " <td>" objFile.WriteLine " " & strProduct objFile.WriteLine " </td>" objFile.WriteLine " <td style=""font-family:'calibri';"">" objFile.WriteLine " " & strKey objFile.WriteLine " </td>" objFile.WriteLine " </tr>" Next Case 4 For i = 0 to UBound(arrExport) - 1 arrProduct = Split(arrExport(i), "||") strProduct = arrProduct(0) strKey = arrProduct(1) strTxt = strTxt & strProduct & _ String(intColumnIndex - Len(strProduct), " ") & _ strKey & vbCrLf Next End Select Select Case ProdKeyExport.Value Case 1 objFile.WriteLine strCSV objFile.Close Set objFile = Nothing objShell.Run strTemp & "\ProdKeys" & strComputer & ".csv" Case 2 Set objRange = objWorkSheet.Range("A1:Z3") Set objRange2 = objWorkSheet.Range("A3:B" & intStartRow - 1) Set objRange3 = objWorkSheet.Range("B4:B" & intStartRow - 1) objRange.Font.Bold = True objRange2.Borders.LineStyle = xlContinuous objRange2.Borders.Weight = xlThin objRange2.Borders.ColorIndex = xlAutomatic objRange3.Font.Name = "calibri" objWorksheet.Range("A1").Select objWorkSheet.Columns("A:ZZ").EntireColumn.AutoFit objExcel.DisplayAlerts = False objExcel.ActiveWorkbook.SaveAs(strTemp & "\ProdKeys" & strComputer & ".xls") objExcel.Visible = True Set objExcel = Nothing Case 3 objFile.WriteLine "</table>" objFile.Close Set objFile = Nothing objShell.Run strTemp & "\ProdKeys" & strComputer & ".htm" Case 4 objFile.WriteLine strTxt objFile.Close Set objFile = Nothing objShell.Run strTemp & "\ProdKeys" & strComputer & ".txt" End Select ProdKeyExport.Value = 0 End Sub '# Verifica a Arquitetura do Windows Function CheckWinArchitecture() On Error Resume Next strArchitecture = "" Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ strComputer & "\root\cimv2") Set colOS = objWMIService.ExecQuery _ ("Select * from Win32_OperatingSystem") For Each objItem In colOS strArchitecture = objItem.OSArchitecture Next If strArchitecture = "" Then Set colProcessor = objWMIService.ExecQuery _ ("Select * from Win32_Processor") For Each objItem In colProcessor intArchitecture = objItem.Architecture Select Case intArchitecture Case 0 strArchitecture = "32-bit" Case 1 strArchitecture = "MIPS" Case 2 strArchitecture = "Alpha" Case 3 strArchitecture = "PowerPC" Case 6 strArchitecture = "IPF" Case 9 strArchitecture = "64-bit" End Select Next End If CheckWinArchitecture = strArchitecture End Function Function DecodeMSKey(arriValues) arrFoundKeys = Array() arrDPID = Array() For i = 52 to 66 ReDim Preserve arrDPID(UBound(arrDPID) + 1) arrDPID(UBound(arrDPID)) = arriValues(i) Next 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") 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 If i Mod 5 = 0 And i <> 0 Then strProductKey = "-" & strProductKey Next ReDim Preserve arrFoundKeys(UBound(arrFoundKeys) + 1) arrFoundKeys(UBound(arrFoundKeys)) = strProductKey strKey = UBound(arrFoundKeys) DecodeMSKey = arrFoundKeys(strKey) End Function

    End Sub sub Window_onLoad() CheckPC() End Sub

    'Autor: Stuart Barrett
            'Este utilitário é Open Source então você pode cortá-la e alterá-lo como quiser </script> <input type="hidden" tabindex="1" id="txtComputerName" size="15"><br><span id="DataArea"></span>


    sexta-feira, 17 de fevereiro de 2012 18:41
  • Aparecido boa noite.

    Ele apresenta erro de script:

    Na linha 418

    Erro:Instrução esperada.

    Voce sabe o que possa ser, pode ajudar?

    sexta-feira, 17 de fevereiro de 2012 20:39
  • Opa, faz o sequinte retire o "end sub" que esta acima do Window_onLoad();

    End Function

    sub Window_onLoad() CheckPC() End

    segunda-feira, 20 de fevereiro de 2012 13:42
  • Alguém teria uma versão desse script para Windows 8.1? O resultado retornado por ele foi diferente do que o esperado para uma instalação padrão do Windows 8.1 Pro sem a digitação de um serial
    segunda-feira, 3 de março de 2014 01:49