Office 2010 Installationsschlüssel auslesen

    Zitat von hightower

    Hab die 105 jetzt mal durch 1617 ersetzt, kommt aber immernoch nicht das richtige :/


    In der Zeit in der du hier rumprobierst an "deine" Keys zu kommen hättest du locker alle Office-Keys einer grossen Bank per Hand inventarisieren können,

    mfg autoBert

    Weil das auch so viel Sinn macht.

    "Wir wissen keine Antwort mehr darauf, aber um irgendwas zu posten, schreiben wir so einen Schrott."

    Glaube nicht das du die Hintergründe kennst und beurteilen kannst das es "sinnvoller" ist jetzt mal eben durch den Schrank zu toben und die Keys manuell in die DB einzutragen.

    Dafür könnt ich auch meine Excel-Datei nehmen. Verstehe auch nicht wieso deine in "" gesetzt wurden ist. Meinst du es geht hier darum fremde Office-Installationsschlüssel auszulesen? Ja, sicher! Daran kann man sich gut bereichern, HARHAR! Wenn du willst schick ich dir die Rechnung über die Office-Lizenzen, dann kannst auch DU ganz beruhigt schalfen gehen.

    Also zurück zum Thema: Hat jemand noch eine Idee? Hier ist noch ein lauffähiger Code in VBS:

    Spoiler anzeigen
    [autoit]

    On Error Resume Next

    Const wbemFlagReturnImmediately = &h10
    Const wbemFlagForwardOnly = &h20

    arrComputers = Array("localhost")
    For Each strComputer In arrComputers

    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", "WQL", _
    wbemFlagReturnImmediately + wbemFlagForwardOnly)

    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", _
    wbemFlagReturnImmediately + wbemFlagForwardOnly)

    Next

    CONST HKEY_LOCAL_MACHINE = &H80000002
    CONST SEARCH_KEY = "DigitalProductID"
    Dim arrSubKeys(7,1)
    Dim foundKeys
    Dim iValues, arrDPID
    foundKeys = Array()
    iValues = Array()
    arrSubKeys(0,0) = "Office2010"
    arrSubKeys(0,1) = "SOFTWARE\Microsoft\Office\14.0\Registration"
    arrSubKeys(1,0) = "Office2010"
    arrSubKeys(1,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\14.0\Registration"
    arrSubKeys(2,0) = "Office2007"
    arrSubKeys(2,1) = "SOFTWARE\Microsoft\Office\12.0\Registration"
    arrSubKeys(3,0) = "Office2007"
    arrSubKeys(3,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\12.0\Registration"
    arrSubKeys(4,0) = "OfficeXP"
    arrSubKeys(4,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\10.0\Registration"
    arrSubKeys(5,0) = "OfficeXP"
    arrSubKeys(5,1) = "SOFTWARE\Microsoft\Office\10.0\Registration"
    arrSubKeys(6,0) = "Office2003"
    arrSubKeys(6,1) = "SOFTWARE\Wow6432Node\Microsoft\Office\11.0\Registration"
    arrSubKeys(7,0) = "Office2003"
    arrSubKeys(7,1) = "SOFTWARE\Microsoft\Office\11.0\Registration"

    strComputer = "."
    Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

    For x = LBound(arrSubKeys, 1) To UBound(arrSubKeys, 1)
    oReg.GetBinaryValue HKEY_LOCAL_MACHINE, arrSubKeys(x,1), SEARCH_KEY, arrDPIDBytes
    If Not IsNull(arrDPIDBytes) Then
    If (x<2) Then
    call decodeKey2(arrDPIDBytes, arrSubKeys(x,0))
    Else
    call decodeKey1(arrDPIDBytes, arrSubKeys(x,0))
    End If
    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
    If (x<2) Then
    call decodeKey2(arrDPIDBytes, arrSubKeys(x,0))
    Else
    call decodeKey1(arrDPIDBytes, arrSubKeys(x,0))
    End If
    End If
    Next
    End If
    End If
    Next

    Function decodeKey1(iValues, strProduct)

    Dim arrDPID
    arrDPID = Array()

    ' <--------------- extract bytes 52-66 of the DPID -------------------------->
    For i = 52 to 66
    ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
    arrDPID( UBound(arrDPID) ) = iValues(i)
    Next

    ' <--------------- Create an array to hold the valid characters for a microsoft -------------------------->
    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")

    ' <--------------- The clever bit !!! (decode the base24 encoded binary data)-------------------------->
    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)

    '' write output data inserted in XML'
    Wscript.Echo "<OFFICEPACK>"
    Wscript.Echo "<OFFICEKEY>" & foundKeys(strKey)& "</OFFICEKEY>"
    Wscript.Echo "<OFFICEVERSION>" & strProduct & "</OFFICEVERSION>"
    Wscript.Echo "</OFFICEPACK>"

    End Function

    Function decodeKey2(iValues, strProduct)

    Dim arrDPID
    arrDPID = Array()

    ' <--------------- extract bytes 52-66 of the DPID -------------------------->
    For i = 808 to 822
    ReDim Preserve arrDPID( UBound(arrDPID) + 1 )
    arrDPID( UBound(arrDPID) ) = iValues(i)
    Next

    ' <--------------- Create an array to hold the valid characters for a microsoft -------------------------->
    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")

    ' <--------------- The clever bit !!! (decode the base24 encoded binary data)-------------------------->
    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)

    '' write output data inserted in XML'
    Wscript.Echo "<OFFICEPACK>"
    Wscript.Echo "<OFFICEKEY>" & foundKeys(strKey)& "</OFFICEKEY>"
    Wscript.Echo "<OFFICEVERSION>" & strProduct & "</OFFICEVERSION>"
    Wscript.Echo "</OFFICEPACK>"

    End Function

    [/autoit]

    Jetzt bin ich doch etwas überrascht, dass das Script gehen soll, da dies eben auf den jene DigitalProductID zugreift die bei Office 2010 wohl nichtmehr existent ist.

    Schau am besten nochmal in dem Pfad: "SOFTWARE\Microsoft\Office\14.0\Registration" bzw. "SOFTWARE\Wow6432Node\Microsoft\Office\14.0\Registration" einschließlich unterornder nach ob doch ein DigitalProductID vorhanden ist.

    Ich kann das hier nur anhand eine Gruppenlizenz prüfen und diese wird nichtmehr in die registry geschrieben das seit Office 2010 eine regelmäßige Prüfung auf einem zentralen Server gemacht wird.

    Kann sein, dass es bei Einzelplatzinstallationen doch wie gehabt diesen Eintrag gibt.

    Andy hat mir ein Schnitzel gebacken aber da war ein Raupi drauf und bevor Oscar das Bugfixen konnte kam Alina und gab mir ein AspirinJunkie.

    Das ist richtig. MAK-Lizenzen werden anders behandelt. Die normalen OEM/Retail-Versionen schreiben Ihre DigitalProductId jedoch immernoch in die Registry!

    Hä? Doch, es eght doch darum, dass das Script angepasst werden muss. Um unter Office 2010 den Key ordnungsgemäß auslesen/verarbeiten zu können muss die Range verändert werden! Von 52 -> 66 zu 808 -> 822.

    Und das scheitert ja im Script ja noch.

    Zitat von hightower

    Glaube nicht das du die Hintergründe kennst und beurteilen kannst das es "sinnvoller" ist jetzt mal eben durch den Schrank zu toben und die Keys manuell in die DB einzutragen.
    Dafür könnt ich auch meine Excel-Datei nehmen.

    Jetzt versteh ichs aber auch nicht mehr. :P
    Du hast die Keys bereits alle in einer Excel Datei? Dann verwende doch einfach die excel UDF um an die Daten zu kommen oder exportiere die relvanten Datensätze von Hand in eine CSV Datei um sie dann problemlos in Autoit weiterverarbeiten zu können.

    Ja, die liegen in einer Exceldatei und ja ich könnte sicherlich per Excel-UDF die Daten irgendwie in die Datenbank bekommen, bringt mir trotzdem nichts, da ich keine Verknüpfung herstellen kann.

    Außerdem ist das nicht das Ziel des Ganzen, das Programm/Script dient zur Inventarisierung! Ziel ist es doch eben, dass ich nicht jede beschi**ene Lizenz per Hand pflegen muss. Alle anderen Lizenzen die wir betreiben/haben hab ich auch schon ohne Probleme ausgelesen. Mit den alten Office-Varianten funktioniert es auch. Das einzige wo es hakt ist OFFICE 2010!

    Also es bringt mir nichts per Exceldatei oder Ordner wühlen die Lizenzen manuell nachzutragen, das ist nicht Ziel des Programms! ->>> Unproduktiv!

    So, also es geht.

    Läuft nun, vielen Dank für die zahlreiche Hilfe. Besonderen Dank an die Jungs die einem dazugeraten haben, die Schlüssel manuell einzuhacken!