[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 299
  • Last Modified:

Get all the machines in the domain's OS key

Hi<

i want to get the licence key serial of all machines in my domain.is there a way to get this.

or scan all machines in the file.

Regards
Sharath
0
bsharath
Asked:
bsharath
  • 5
  • 5
1 Solution
 
stergiumCommented:
hello
i think that this http://software.techrepublic.com.com/download.aspx?docid=286191 does what you want.
Note: I've never tried. :/
0
 
RobSampsonCommented:
Sharath, here is VBScript that will give you the Windows XP product key from a remote PC.  If you have a list of computers in a file, we can make it go through those, and write, say:
COMPNAME:    xxxx-xxxx-xxxx-xxxx

to a file.

'=============
Set objNetwork = CreateObject("WScript.Network")
strPC = InputBox("Enter the computer to read the Windows XP from:", "Source Computer", objNetwork.ComputerName)
WScript.Echo sGetXPCDKey(strPC)

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)
   
      Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
          strComputer & "\root\default:StdRegProv")

      strKeyPath = "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion\"
      strValueName = "DigitalProductId"
      objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, bDigitalProductID

    'Set objShell = CreateObject("WScript.Shell")
    'bDigitalProductID = objShell.RegRead("\\" & strComputer & "\HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion\DigitalProductId")
    '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
   
End Function
'=============

Regards,

Rob.
0
 
bsharathAuthor Commented:
This link only shows the local computer serail no.How can i find all machines in the network's Licence key?
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
bsharathAuthor Commented:
Rob

this is working great for 1 machine.can it take the names from a file and give results to a file....
0
 
RobSampsonCommented:
Sharath, here you go:
'===========
strInputFile = "computers.txt"
strOutputFile = "OS_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)
   
      Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
          strComputer & "\root\default:StdRegProv")

      strKeyPath = "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion\"
      strValueName = "DigitalProductId"
      objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, bDigitalProductID

    'Set objShell = CreateObject("WScript.Shell")
    'bDigitalProductID = objShell.RegRead("\\" & strComputer & "\HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion\DigitalProductId")
    '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
   
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
'===========

Regards,

Rob.
0
 
bsharathAuthor Commented:
Rob it works but if a machine is not found it throws and error.
Can you please give error on resume and to specify the error in the results file

0
 
RobSampsonCommented:
OK, try this version:
'============
strInputFile = "computers.txt"
strOutputFile = "OS_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 & "\root\default:StdRegProv")
      If Err.Number = 0 Then
            strKeyPath = "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion\"
            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_MACHINE\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion\DigitalProductId")
                '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
'============

Regards,

Rob.
0
 
RobSampsonCommented:
By the way, are you still getting those GetObject failed messages?  I still have a feeling that some of your machines are either locked down to heavily, or there is something wrong with DCOM in them......

Regards,

Rob.
0
 
bsharathAuthor Commented:
Thanks a lot Rob...
0
 
RobSampsonCommented:
No worries.....you've got some interesting questions, but too many for me to look at them all.... :-)

Rob.
0
 
bsharathAuthor Commented:
If possible take time on the Q's it would be very helpful to me....

THX
Sharath
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 5
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now