How to retrieve OS serials with one or more machines?

How to retrieve OS serials with one or more machines?

Here is a script that can do it.

1. Save the below code into a VBS file.

2. Paste in all machine names into the "machines.txt" file.

3. Have the VBS and the txt file in same path.

4. Double click on the VBS script to execute.

5. Once completed you will get a file called keys.txt created in the same folder where you have the other 2 files.

strInputFile = "Machines.txt"
strOutputFile = "Keys.txt"
Const intForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInputFile = objFSO.OpenTextFile(strInputFile, intForReading, False)
Set objOutputFile = objFSO.CreateTextFile(strOutputFile, True)
While Not objInputFile.AtEndOfStream
strComputer = objInputFile.ReadLine
boolResult = Ping(strComputer)
If boolResult = True Then
objOutputFile.WriteLine strComputer & ": " & sGetXPCDKey(strComputer)

Else

objOutputFile.WriteLine strComputer & " could not be pinged"

End If

Wend

objOutputFile.Close
objInputFile.Close
Set objOutputFile = Nothing
Set objInputFile = Nothing
Set objFSO = Nothing

MsgBox "Done"

Public Function sGetXPCDKey(strComputer)

Dim bDigitalProductID
Dim bProductKey()
Dim bKeyChars(24)
Dim ilByte
Dim nCur
Dim sCDKey
Dim ilKeyByte
Dim ilBit
    
Const HKEY_LOCAL_MACHINE = &H80000002
    
ReDim Preserve bProductKey(14)
    
On Error Resume Next
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\" & _
strComputer & "rootdefault:StdRegProv")
If Err.Number = 0 Then
strKeyPath = "SOFTWAREMICROSOFTWindows NTCurrentVersion"
strValueName = "DigitalProductId"
objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, bDigitalProductID
           
If Err.Number = 0 Then
'Set objShell = CreateObject("WScript.Shell")
'bDigitalProductID = objShell.RegRead("\" & strComputer & "HKEY_LOCAL_MACHINESOFTWAREMICROSOFTWindows NTCurrentVersionDigitalProductId")
'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

               
sGetXPCDKey = sCDKey

Else

sGetXOCDKey = "ERROR " & Err.Number & ": " & Err.Description

Err.Clear
On Error GoTo 0
End If
Else
sGetXOCDKey = "ERROR " & Err.Number & ": " & Err.Description
Err.Clear
On Error GoTo 0
End If
    
End Function

Function Ping(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shell")
boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
If boolCode = 0 Then
Ping = True
Else
Ping = False
End If
End Function

Hope this helps.