bsharath
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
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
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.Netw ork")
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:{imper sonationLe vel=impers onate}!\\" & _
strComputer & "\root\default:StdRegProv" )
strKeyPath = "SOFTWARE\MICROSOFT\Window s NT\CurrentVersion\"
strValueName = "DigitalProductId"
objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, bDigitalProductID
'Set objShell = CreateObject("WScript.Shel l")
'bDigitalProductID = objShell.RegRead("\\" & strComputer & "\HKEY_LOCAL_MACHINE\SOFTW ARE\MICROS OFT\Window s NT\CurrentVersion\DigitalP roductId")
'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.
COMPNAME: xxxx-xxxx-xxxx-xxxx
to a file.
'=============
Set objNetwork = CreateObject("WScript.Netw
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:{imper
strComputer & "\root\default:StdRegProv"
strKeyPath = "SOFTWARE\MICROSOFT\Window
strValueName = "DigitalProductId"
objRegistry.GetBinaryValue
'Set objShell = CreateObject("WScript.Shel
'bDigitalProductID = objShell.RegRead("\\" & strComputer & "\HKEY_LOCAL_MACHINE\SOFTW
'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.
ASKER
This link only shows the local computer serail no.How can i find all machines in the network's Licence key?
ASKER
Rob
this is working great for 1 machine.can it take the names from a file and give results to a file....
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.Fi leSystemOb ject")
Set objInputFile = objFSO.OpenTextFile(strInp utFile, intForReading, False)
Set objOutputFile = objFSO.CreateTextFile(strO utputFile, 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:{imper sonationLe vel=impers onate}!\\" & _
strComputer & "\root\default:StdRegProv" )
strKeyPath = "SOFTWARE\MICROSOFT\Window s NT\CurrentVersion\"
strValueName = "DigitalProductId"
objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, bDigitalProductID
'Set objShell = CreateObject("WScript.Shel l")
'bDigitalProductID = objShell.RegRead("\\" & strComputer & "\HKEY_LOCAL_MACHINE\SOFTW ARE\MICROS OFT\Window s NT\CurrentVersion\DigitalP roductId")
'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.Shel l")
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.
'===========
strInputFile = "computers.txt"
strOutputFile = "OS_Keys.txt"
Const intForReading = 1
Set objFSO = CreateObject("Scripting.Fi
Set objInputFile = objFSO.OpenTextFile(strInp
Set objOutputFile = objFSO.CreateTextFile(strO
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:{imper
strComputer & "\root\default:StdRegProv"
strKeyPath = "SOFTWARE\MICROSOFT\Window
strValueName = "DigitalProductId"
objRegistry.GetBinaryValue
'Set objShell = CreateObject("WScript.Shel
'bDigitalProductID = objShell.RegRead("\\" & strComputer & "\HKEY_LOCAL_MACHINE\SOFTW
'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.Shel
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.
ASKER
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
Can you please give error on resume and to specify the error in the results file
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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.
Regards,
Rob.
ASKER
Thanks a lot Rob...
No worries.....you've got some interesting questions, but too many for me to look at them all.... :-)
Rob.
Rob.
ASKER
If possible take time on the Q's it would be very helpful to me....
THX
Sharath
THX
Sharath
i think that this http://software.techrepublic.com.com/download.aspx?docid=286191 does what you want.
Note: I've never tried. :/