104 lines
3.6 KiB
Plaintext
104 lines
3.6 KiB
Plaintext
CONST HKEY_LOCAL_MACHINE = &H80000002
|
|
CONST SEARCH_KEY = "DigitalProductID"
|
|
|
|
Dim args
|
|
Set args = Wscript.Arguments
|
|
Set WshShell = CreateObject("WScript.Shell")
|
|
|
|
Argument1 = args(0)
|
|
|
|
Dim arrSubKeys(6,1)
|
|
Dim foundKeys
|
|
Dim iValues, arrDPID
|
|
foundKeys = Array()
|
|
iValues = Array()
|
|
strComputer = "."
|
|
|
|
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
|
|
Set colProcessors = objWMIService.ExecQuery("Select * from Win32_Processor")
|
|
For Each objProcessor in colProcessors
|
|
Select Case objProcessor.AddressWidth
|
|
Case 32
|
|
arrSubKeys(2,0) = "Microsoft Office XP"
|
|
arrSubKeys(2,1) = "SOFTWARE\Microsoft\Office\10.0\Registration"
|
|
arrSubKeys(1,0) = "Microsoft Office 2003"
|
|
arrSubKeys(1,1) = "SOFTWARE\Microsoft\Office\11.0\Registration"
|
|
arrSubKeys(3,0) = "Microsoft Office 2007"
|
|
arrSubKeys(3,1) = "SOFTWARE\Microsoft\Office\12.0\Registration"
|
|
arrSubKeys(4,0) = "Microsoft Office 2010"
|
|
arrSubKeys(4,1) = "SOFTWARE\Microsoft\Office\14.0\Registration"
|
|
Case 64
|
|
arrSubKeys(2,0) = "Microsoft Office XP"
|
|
arrSubKeys(2,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\10.0\Registration"
|
|
arrSubKeys(1,0) = "Microsoft Office 2003"
|
|
arrSubKeys(1,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\11.0\Registration"
|
|
arrSubKeys(3,0) = "Microsoft Office 2007"
|
|
arrSubKeys(3,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\12.0\Registration"
|
|
arrSubKeys(4,0) = "Microsoft Office 2010"
|
|
arrSubKeys(4,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\14.0\Registration"
|
|
End Select
|
|
next
|
|
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
|
|
|
|
For x = 1 To 4
|
|
oReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1), SEARCH_KEY, arrDPIDBytes
|
|
If Not IsNull(arrDPIDBytes) Then
|
|
call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
|
|
Else
|
|
oReg.EnumKey HKEY_LOCAL_MACHINE, arrSubKeys(x,1), arrGUIDKeys
|
|
If Not IsNull(arrGUIDKeys) Then
|
|
For Each GUIDKey In arrGUIDKeys
|
|
oReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1) & "\" & GUIDKey, SEARCH_KEY, arrDPIDBytes
|
|
If Not IsNull(arrDPIDBytes) Then
|
|
CodeRetour = tracelog(Argument1 & "\GetLicenceOffice.txt", arrSubKeys(x,0))
|
|
call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
|
|
End If
|
|
Next
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
Function decodeKey(iValues, strProduct)
|
|
Dim arrDPID
|
|
arrDPID = Array()
|
|
|
|
For i = 52 to 66
|
|
ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
|
|
arrDPID( UBound(arrDPID) ) = iValues(i)
|
|
Next
|
|
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")
|
|
|
|
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
|
|
If i Mod 5 = 0 And i <> 0 Then strProductKey = "-" & strProductKey
|
|
Next
|
|
|
|
ReDim Preserve foundKeys( UBound(foundKeys) + 1 )
|
|
foundKeys( UBound(foundKeys) ) = strProductKey
|
|
strKey = UBound(foundKeys)
|
|
wscript.echo ( "Product(license) key is " & foundKeys(strKey))
|
|
CodeRetour = tracelog(Argument1 & "\GetLicenceOffice.txt", foundKeys(strKey))
|
|
End Function
|
|
|
|
' ********** Fonction **********************************************************************************************
|
|
Function GetPath()
|
|
Dim path
|
|
path = WScript.ScriptFullName
|
|
GetPath = Left(path, InStrRev(path, "\"))
|
|
End Function
|
|
|
|
Function TraceLog(FichierLog,Commentaire)
|
|
Dim oFso, fich
|
|
Set oFso = CreateObject("Scripting.FileSystemObject")
|
|
Set fich = oFso.OpenTextFile(FichierLog,8,True)
|
|
fich.writeline Commentaire
|
|
fich.close
|
|
End Function
|