Visual Basic Script em VBS para mostrar info do Windows

[Erso]

Bom dia,

Estou tentando criar um script em VBS que mostre:

- A versão do Windows instalada (ex: Windows 10 Home)

- A build number

- A Product Key

- E gere um arquivo TXT com essas informações.

Encontrei esses dois scripts:

 

Este primeiro mostra a build number, porém exibe a product key errada:

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

 

Este segundo exibe a product key correta e tem a opção de gerar o arquivo TXT, porém não mostra a build number:

Option Explicit  
 
Dim objshell,path,DigitalID, Result  
Set objshell = CreateObject("WScript.Shell") 
'Set registry key path 
Path = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\" 
'Registry key value 
DigitalID = objshell.RegRead(Path & "DigitalProductId") 
Dim ProductName,ProductID,ProductKey,ProductData 
'Get ProductName, ProductID, ProductKey 
ProductName = "Product Name: " & objshell.RegRead(Path & "ProductName") 
ProductID = "Product ID: " & objshell.RegRead(Path & "ProductID") 
ProductKey = "Installed Key: " & ConvertToKey(DigitalID)  
ProductData = ProductName  & vbNewLine & ProductID  & vbNewLine & ProductKey 
'Show messbox if save to a file  
If vbYes = MsgBox(ProductData  & vblf & vblf & "Save to a file?", vbYesNo + vbQuestion, "BackUp Windows Key Information") then 
   Save ProductData  
End If 
 
 
 
'Convert binary to chars 
Function ConvertToKey(Key) 
    Const KeyOffset = 52 
    Dim isWin8, Maps, i, j, Current, KeyOutput, Last, keypart1, insert 
    'Check if OS is Windows 8 
    isWin8 = (Key(66) \ 6) And 1 
    Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4) 
    i = 24 
    Maps = "BCDFGHJKMPQRTVWXY2346789" 
    Do 
           Current= 0 
        j = 14 
        Do 
           Current = Current* 256 
           Current = Key(j + KeyOffset) + Current 
           Key(j + KeyOffset) = (Current \ 24) 
           Current=Current Mod 24 
            j = j -1 
        Loop While j >= 0 
        i = i -1 
        KeyOutput = Mid(Maps,Current+ 1, 1) & KeyOutput 
        Last = Current 
    Loop While i >= 0  
     
    If (isWin8 = 1) Then 
        keypart1 = Mid(KeyOutput, 2, Last) 
        insert = "N" 
        KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0) 
        If Last = 0 Then KeyOutput = insert & KeyOutput 
    End If     
     
 
    ConvertToKey = Mid(KeyOutput, 1, 5) & "-" & Mid(KeyOutput, 6, 5) & "-" & Mid(KeyOutput, 11, 5) & "-" & Mid(KeyOutput, 16, 5) & "-" & Mid(KeyOutput, 21, 5) 
    
     
End Function 
'Save data to a file 
Function Save(Data) 
    Dim fso, fName, txt,objshell,UserName 
    Set objshell = CreateObject("wscript.shell") 
    'Get current user name  
    UserName = objshell.ExpandEnvironmentStrings("%UserName%")  
    'Create a text file on desktop  
    fName = "C:\Users\" & UserName & "\Desktop\WindowsKeyInfo.txt" 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set txt = fso.CreateTextFile(fName) 
    txt.Writeline Data 
    txt.Close 
End Function

 

Tentei montar um novo script utilizando as partes que preciso de cada um deles, porém como não tenho conhecimento em programação não obtive sucesso.

Se alguém com experiência na área puder me dar uma força eu agradeço!

 

[ricardo_br]

Você quer a chave do Windows que está armazenada na placa-mãe ou a que está instalada no Windows? Em algumas situações essas chaves podem ser diferentes.

[Basole]

@Erso fiz as adaptações nos códigos que você postou.

Veja se é isso (anexo):

 

 

 

 

[ricardo_br]

@Basole Acho que você mandou a chave do seu Windows junto de brinde....

[Basole]

@ricardo_br valeu cara comi bola!

Obrigado, já removi do post e atualizei aqui

 

 

 

InfoWim.zip

[ricardo_br]

Para mim deu nisso:

 

 

[Erso]

@ricardo_br a que está instalada no Windows. Já tive problemas em reinstalações de Windows onde o instalador não reconheceu a chave da placa-mãe e, consequentemente, não ativou o SO.

@Basole o arquivo zipado está com o .txt com a chave do seu Win.

[ricardo_br]

@Erso Isso pode ser problema de versão ou edição do Windows. Por exemplo seu computador veio com Windows 8 ai se você for instalar o Windows 10 a chave vai ser do Windows 8 e não vai aceitar ou seu computador veio com Windows 10 Home e você quer instalar Windows Pro, mais a chave só serve para Windows 10 home...

[Erso]

@ricardo_br já reinstalei algumas vezes o Windows trocando de versão, do Win7/8/8.1 para o W10 e a chave funcionou belezinha, a única ressalva é que ele mantem a característica da versão. Ex.: Se era W7 Home, atualiza para W10 Home, se era W8 Educacional, atualiza para W10 educacional. O problema é que em alguns vai de boa, em outros não, um problema que parece meio aleatório.

[Basole]

@ricardo_br pra mim rodou perfeitamente 

@Erso obrigado, eu ja alterei manualmente o txt anexo e atualizei

[Erso]

1 minuto atrás, Basole disse:

@ricardo_br pra mim rodou perfeitamente 

@Basole Aqui também rodou de boa. Obrigado.

[ricardo_br]

@Basole Seria porque no meu registro do Windows não existe a pasta UBR? Eu uso Windows 8.1...

[Basole]

@ricardo_br pode ser, mas experimente este batch...

 

for /f "tokens=2*" %%a in ('Reg Query "HKLM\Software\Microsoft\Windows NT\CurrentVersion" /v ProductName') do set "ProductName=%%~b"
for /f "tokens=2*" %%a in ('Reg Query "HKLM\Software\Microsoft\Windows NT\CurrentVersion" /v CurrentVersion') do set "CurrentVersion=%%~b"
for /f "tokens=2*" %%a in ('Reg Query "HKLM\Software\Microsoft\Windows NT\CurrentVersion" /v CurrentBuild') do set "CurrentBuildHex=%%~b"
for /f "tokens=2*" %%a in ('Reg Query "HKLM\Software\Microsoft\Windows NT\CurrentVersion" /v UBR') do set "UBRHEX=%%~b"
set /a CurrentBuildDec=%CurrentBuildHex%
set /a UBRDEC=%UBRHEX%
echo %computername% %ProductName% Version: %CurrentVersion%, Build: %CurrentBuildDec%.%UBRDEC%

 

[ricardo_br]

@Basole Bem depois que adicionei um @echo off e um pause deu isso:

 

 

Windows 8.1 não tem UBR.....

 

[Basole]

@ricardo_br realmente no seu PC, não existe esse caminho [\UBR]

 

Experimente este outro vbscript 

 

Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set oss = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")

For Each os in oss
dtmConvertedDate.Value = os.InstallDate 
dtmInstallDate = dtmConvertedDate.GetVarDate
    Wscript.Echo "Boot Device: " & os.BootDevice & vbnewline & _
     vbnewline & "Build Number: " & os.BuildNumber & _
     vbnewline & "Build Type: " & os.BuildType & _
     vbnewline & "Caption: " & os.Caption & _
     vbnewline & "Code Set: " & os.CodeSet & _
     vbnewline & "Country Code: " & os.CountryCode & _
     vbnewline & "Debug: " & os.Debug & _
     vbnewline & "Encryption Level: " & os.EncryptionLevel & _    
     vbnewline & "Install Date: " & dtmInstallDate & _ 
     vbnewline & "Licensed Users: " & os.NumberOfLicensedUsers & _
     vbnewline & "Organization: " & os.Organization & _
     vbnewline & "OS Language: " & os.OSLanguage & _
     vbnewline & "OS Product Suite: " & os.OSProductSuite & _
     vbnewline & "OS Type: " & os.OSType & _
     vbnewline & "Primary: " & os.Primary & _
     vbnewline & "Registered User: " & os.RegisteredUser & _
     vbnewline & "Serial Number: " & os.SerialNumber & _
     vbnewline & "Version: " & os.Version
Next

* salvar com extensão *.vbs