×
Ir ao conteúdo
  • Cadastre-se

Visual Basic Script em VBS para mostrar info do Windows


Ir à solução Resolvido por Basole,

Posts recomendados

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!

 

Link para o comentário
Compartilhar em outros sites

@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...

Link para o comentário
Compartilhar em outros sites

@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.

Link para o comentário
Compartilhar em outros sites

@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%

 

Link para o comentário
Compartilhar em outros sites

@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

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Aprenda a ler resistores e capacitores

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!