Link to home
Start Free TrialLog in
Avatar of bsharath
bsharathFlag for India

asked on

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
Avatar of stergium
stergium
Flag of Greece image

hello
i think that this http://software.techrepublic.com.com/download.aspx?docid=286191 does what you want.
Note: I've never tried. :/
Avatar of RobSampson
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.
Avatar of bsharath

ASKER

This link only shows the local computer serail no.How can i find all machines in the network's Licence key?
Rob

this is working great for 1 machine.can it take the names from a file and give results to a file....
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.
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

ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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.
Thanks a lot Rob...
No worries.....you've got some interesting questions, but too many for me to look at them all.... :-)

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

THX
Sharath