Welcome !
         

 Retrieve Windows Product Key

Change Page: 123 > | Showing page 1 of 3, messages 1 to 20 of 49
Author Message
Parabellum

  • Total Posts : 256
  • Scores: 4
  • Reward points : 0
  • Joined: 11/12/2006
  • Location: UK
  • Status: offline
Retrieve Windows Product Key Thursday, February 01, 2007 10:28 AM (permalink)
5



UPDATED 7/19/2007

SEE POSTS BELOW!!!
 
 
Retrieve Windows Product Key

I realise there are many tools out there that will achieve this same task, but a vbs version also has its advantages...
with a few modifications you could for example run this as a logon script to log a copy of all Product keys in use in a domain
Also i just wanted to see if i could do it :)

Basicaly this script retrieves the DigitalProductID from the registry, extracts the actual bytes which relate product Key
and then decodes the base24 binary data to show the key, as you know it.

I can't take credit for figuring out the base24 decoding...( i adapted that from a c++  app)

 '  ##############################################################
 '  #        #
 '  # VBScript to find the DigitalProductID for your  #
 '  # Microsoft windows Installation and decode it to  #
 '  # retrieve your windows Product Key    #
 '  #        #
 '  # -----------------------------------------------  #
 '  #        #
 '  #  Created by:  Parabellum   #
 '  #        #
 '  ##############################################################
 '
 ' <--------------- Open Registry Key and populate binary data into an array -------------------------->
 '
 const HKEY_LOCAL_MACHINE = &H80000002 
 strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
 strValueName = "DigitalProductId"
 strComputer = "."
 dim iValues()
 Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
       strComputer & "\root\default:StdRegProv")
 oReg.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,iValues
 Dim arrDPID
 arrDPID = Array()
 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 Product Key -------------------------->
 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 !!! (Decrypt 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
 ' <------- add the "-" between the groups of 5 Char -------->
 If i Mod 5 = 0 And i <> 0 Then strProductKey = "-" & strProductKey
 Next
 strFinalKey = strProductKey
 '
 ' <---------- This part of the script displays operating system Information and the license Key --------->
 '
 strComputer = "."
 Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 Set colOperatingSystems = objWMIService.ExecQuery _
    ("Select * from Win32_OperatingSystem")
 For Each objOperatingSystem in colOperatingSystems
    strOS   = objOperatingSystem.Caption
    strBuild   = objOperatingSystem.BuildNumber
    strSerial   = objOperatingSystem.SerialNumber
    strRegistered  = objOperatingSystem.RegisteredUser
 Next
 Set wshShell=CreateObject("wscript.shell")
 strPopupMsg = strOS & vbNewLine & vbNewLine
 strPopupMsg = strPopupMsg & "Build Number:  " & strBuild & vbNewLine
 strPopupMsg = strPopupMsg & "PID:  " & strSerial & vbNewLine & vbNewLine
 strPopupMsg = strPopupMsg & "Registered to:  " & strRegistered & vbNewLine & vbNewLine & vbNewLine
 strPopupMsg = strPopupMsg & "Your Windows Product Key is:" & vbNewLine & vbNewLine & strFinalKey
 strPopupTitle = "Microsoft Windows License Information"
 wshShell.Popup strPopupMsg,,strPopupTitle,vbCancelOnly+vbinformation
 WScript.Quit
 



the same Code can also be applied to retrieve other microsoft DigitalProductID's (eg office)
It's just a matter of locating the corresponding registry key..


Here's a script to show an office 2003 key

 '  ##############################################################
 '  #        #
 '  # VBScript to find the DigitalProductID for your  #
 '  # Microsoft Office 2003 Installation and decode   #
 '  # it to retrieve your Product Key     #
 '  #        #
 '  # -----------------------------------------------  #
 '  #        #
 '  #  Created by:  Parabellum   #
 '  #        #
 '  ##############################################################
 '
 ' <--------------- Open Registry Key and populate binary data into an array -------------------------->
 '
 const HKEY_LOCAL_MACHINE = &H80000002 
 strKeyPath = "SOFTWARE\Microsoft\Office\11.0\Registration\{90110409-6000-11D3-8CFE-0150048383C9}"
 strValueName = "DigitalProductId"
 strComputer = "."
 dim iValues()
 Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
       strComputer & "\root\default:StdRegProv")
 oReg.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,iValues
 Dim arrDPID
 arrDPID = Array()
 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 Product Key -------------------------->
 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 !!! (Decrypt 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
 strFinalKey = strProductKey
 '
 ' <--------------- This part of the script displays a completed/summary message ----------------->
 '
 Set wshShell=CreateObject("wscript.shell")
 strPopupMsg = "Your Microsoft Office 2003 Product Key is:" & vbNewLine & vbNewLine & strFinalKey
 strPopupTitle = "Product Key"
 wshShell.Popup strPopupMsg,,strPopupTitle,vbCancelOnly+vbinformation
 WScript.Quit
 


you can use this method to retrieve keys for windows 2000 onwards.. (tested on my Vista machine also..!) and for Office Products later than office XP

any comments or feedback appreciated
<message edited by Parabellum on Thursday, July 19, 2007 7:16 AM>
 
#1
    dm_4ever

    • Total Posts : 3712
    • Scores: 93
    • Reward points : 0
    • Joined: 6/29/2006
    • Location: Orange County, California
    • Status: offline
    RE: Retrieve Windows Product Key Thursday, February 01, 2007 3:17 PM (permalink)
    0
    Very neat and actually since you're using WMI to read HKLM, you could retrieve the information remotely without having to include it in a login script.  
    dm_4ever

    My philosophy: K.I.S.S - Keep It Simple Stupid
    Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
    Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm
     
    #2
      Parabellum

      • Total Posts : 256
      • Scores: 4
      • Reward points : 0
      • Joined: 11/12/2006
      • Location: UK
      • Status: offline
      RE: Retrieve Windows Product Key Sunday, February 04, 2007 1:00 PM (permalink)
      0
       
      I modified the above code to make it a little more useful and user friendly,
       
      It now detects multiple Microsoft Products.
      It reads the Registry paths and Product name from an array which can be easily updated with other Microsoft Products
      It also now searches that path for the installation GUID (which varies from different versions of office such as oem vlk etc.)
       
      enjoy...
       
      any comments or improvment suggestions appreciated
       
       '  ##############################################################
       '  #        #
       '  # VBScript to retrieve Microsoft Product Keys  #
       '  # from the registry by decoding DigitalProductID's #
       '  #        #
       '  # -------------------------------------------------- #
       '  # Created by: Parabellum     #
       '  #        #
       '  ##############################################################
       '
       CONST HKEY_LOCAL_MACHINE = &H80000002
       CONST SEARCH_KEY = "DigitalProductID"
       Dim arrSubKeys(4,1)
       Dim foundKeys
       Dim iValues, arrDPID
       foundKeys = Array()
       iValues = Array()
       arrSubKeys(0,0) = "Microsoft Windows Product Key"
       arrSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
       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 Exchange Product Key"
       arrSubKeys(4,1) = "SOFTWARE\Microsoft\Exchange\Setup"
        
       ' <--------------- Open Registry Key and populate binary data into an array -------------------------->
       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
         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
            call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
           End If
          Next
         End If
        End If
       Next
       MsgBox("Finished")
       
       ' <----------------------------------------- Return the Product Key --------------------------------------------------->
       Function decodeKey(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 Product Key -------------------------->
        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)
        MsgBox strProduct & vbNewLine & vbNewLine & foundKeys(strKey)
       End Function
        
       

       
      #3
        Parabellum

        • Total Posts : 256
        • Scores: 4
        • Reward points : 0
        • Joined: 11/12/2006
        • Location: UK
        • Status: offline
        RE: Retrieve Windows Product Key Monday, February 05, 2007 10:30 AM (permalink)
        0
        and finally... an HTA version
         
          <html>
         <head>
         <title>Microsoft Product Key Retrieval</title>
         <hta:application
          applicationname="MSKeyRetrieval" 
          caption="MSKeyRetrieval"
          contextmenu="no"
          maximizebutton="no"
          minimizebutton="yes"
          navigable="yes"
          showintaskbar="yes"
          singleinstance="yes"
          sysmenu="yes"
         >
         </head>
         <script language="VBScript">
         Const HKEY_LOCAL_MACHINE = &H80000002
         Const SEARCH_KEY = "DigitalProductID"
         Dim foundKeys
         Dim iValues
         Dim arrDPID
         Dim strHTML
         Dim arrSubKeys(4,1)
         foundKeys = Array()
         iValues = Array()
         arrSubKeys(0,0) = "Microsoft Windows"
         arrSubKeys(0,1) = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
         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 Exchange Product Key"
         arrSubKeys(4,1) = "SOFTWARE\Microsoft\Exchange\Setup"
         Sub window_onload
          ' <--------------- Set window Size --------------->
                 strComputer = "."
                 Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
                 Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
                 For Each objItem in colItems
                     intHorizontal = objItem.ScreenWidth
                     intVertical = objItem.ScreenHeight
                 Next
                 intLeft = (intHorizontal - 500) / 2
                 intTop = (intVertical - 600) / 2
                 window.resizeTo 500,600
                 window.moveTo intLeft, intTop
           
          ' <--------------- Open Registry Key and populate binary data into an array -------------------------->
          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
            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
               call decodeKey(arrDPIDBytes, arrSubKeys(x,0))
              End If
             Next
            End If
           End If
          Next
          If IsNull(foundkeys) Then
           DataArea.InnerHTML = "No Keys Found" 
          Else
           DataArea.InnerHTML = strHTML
          End If 
         End Sub
         ' <----------------------- Return the Product Key ------------------------>
         Function decodeKey(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 Product Key -------------------------->
          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
          If strProduct = "Microsoft Windows" Then
           strComputer = "."
           Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
           Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")
           For Each objOperatingSystem in colOperatingSystems
            strOS = objOperatingSystem.Caption
           Next
           strHTML = strHTML & "<h3>" & strOS & "</h3>" & _
             "<h4>" & strProductKey & "</h4><br /><hr /><br />"
          Else
           strHTML = strHTML & "<h3>" & strProduct & "</h3>" & _
             "<h4>" & strProductKey & "</h4><br /><hr /><br />"
          End If
         End Function
         
         </script>
         <body>
         <div id="header" style="color:#ffffff; height:100px; text-align:center; font-family:Tahoma;
           filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#0011aa', EndColorStr='#ffffff')">
           <br /><h2>Retrieved Microsoft Product Keys</h2>
         </div><hr />
         <span id="DataArea"></span>
         <br />
         <div id="Print" style="text-align:center;"><input type="button" value="Print" Onclick="print()" ;></div>
         </body>
         </html>
         
         

         
        #4
          est

          • Total Posts : 40
          • Scores: 0
          • Reward points : 0
          • Joined: 10/12/2006
          • Status: offline
          RE: Retrieve Windows Product Key Saturday, February 10, 2007 1:13 AM (permalink)
          0
          It's great! It worked on my Vista RC2, but not my Office 2007 :( Maybe the registry key path is changed.
          Do NOT program in a programmer's way
           
          #5
            arnabvb

            • Total Posts : 1
            • Scores: 0
            • Reward points : 0
            • Joined: 2/10/2007
            • Status: offline
            RE: Retrieve Windows Product Key Saturday, February 10, 2007 4:48 PM (permalink)
            0
            I've seen that there is a key called 'Product Key' in Registry which contain only numbers and 24 long. Is there any relation between this pruct id and my original key???? Help plezzz....
             
            #6
              Parabellum

              • Total Posts : 256
              • Scores: 4
              • Reward points : 0
              • Joined: 11/12/2006
              • Location: UK
              • Status: offline
              RE: Retrieve Windows Product Key Sunday, February 11, 2007 6:18 AM (permalink)
              0
              est: are you using the HTA version, in my third post?? becuase i've tested that on a machine with office 2007 (full not beta) and that worked fine??
              you could check if the key exists manualy.... should be in 

              HKLM>SOFTWARE>MICROSOFT>OFFICE>12>{GUID}>"DigitalProductID"

              arnabvb: where was this key located? There will be many references to a key called "ProductID" this is Relates to your Product Installation ID that is displayed under you sytem properties..
              This value is generated from a number of details, including... the Machine hardware, type of disc used for instalation.. and the Product key used.
              I couldn't find a key call Product Key on my machine.
              I know windows 98 used to store the Product key directly in the regitry using a key called "Product Key", are you using win98, or was your PC upgraded from windows 98? (This script doesn't run on windows 98)
               
              if you post the key value, i can check into it...
               
              It is also possible to retrieve a key from aniother PC that wont boot, by copying the DAT Files for the registry from the harddrive, and loading them into a live registry.
              I will post instructions and a script to do this as soon as i get chance.
               
              #7
                gormly

                • Total Posts : 1
                • Scores: 0
                • Reward points : 0
                • Joined: 2/23/2007
                • Status: offline
                RE: Retrieve Windows Product Key Friday, February 23, 2007 3:56 AM (permalink)
                0
                wow this is fantastic and just what I was looking for .. 
                 
                 
                 
                Except, I need some help with this in .net
                 
                I am new to visual basic.net
                It will not let me use the arrays, I have tried just about everything I can think of, I have most of it converted correctly except the array parts.
                can anyone convert this to VB.net please?
                 
                 
                 
                 
                #8
                  Parabellum

                  • Total Posts : 256
                  • Scores: 4
                  • Reward points : 0
                  • Joined: 11/12/2006
                  • Location: UK
                  • Status: offline
                  RE: Retrieve Windows Product Key Friday, February 23, 2007 9:07 AM (permalink)
                  0
                  sorry... my .net experience goes at about as far as ASP and databases... out of my league... any reason for converting to .net...??
                  I might be able to help in some other way
                   
                  #9
                    bushmaoribob

                    • Total Posts : 5
                    • Scores: 0
                    • Reward points : 0
                    • Joined: 3/1/2007
                    • Status: offline
                    RE: Retrieve Windows Product Key Friday, March 02, 2007 1:10 PM (permalink)
                    0
                    Great script Parabellum
                     
                    Your first Script posted on this article is Great, (just how to find the Windows Product key)
                     
                     
                    Do you know how to save the Output to a text file, or make a option to save in the output box?
                     
                    Also do you know how to make the script run "behind the scences" and just save to a text file?
                     
                     
                    If you know please reply, thanks for your help
                     

                     
                    #10
                      bushmaoribob

                      • Total Posts : 5
                      • Scores: 0
                      • Reward points : 0
                      • Joined: 3/1/2007
                      • Status: offline
                      RE: Retrieve Windows Product Key Friday, March 02, 2007 2:01 PM (permalink)
                      0
                      Haha i forgot something,
                       
                      Also you say you know how to Modify the script to find all product keys in a domain??
                       
                      Can you possibly release a Script that can do that?, will it list the ip's and the Productkeys relating to it?????
                       
                      And Can you Possibly release a script that can  save the Output to a text file, or make a option to save in the output box?  or make the script run "behind the scences" and just save to a text file???
                       
                      Thanks Heapss

                       
                      #11
                        bushmaoribob

                        • Total Posts : 5
                        • Scores: 0
                        • Reward points : 0
                        • Joined: 3/1/2007
                        • Status: offline
                        RE: Retrieve Windows Product Key Friday, March 02, 2007 2:38 PM (permalink)
                        0
                        Haha i allways forget something,

                        Also...Could you make a script in association to the script that can find windows and office product keys, with an option to close at a first message before it shows any of your keys, for example:

                        USE AT OWN RISK

                        OK                CLOSE NOW

                        the ok and close now in dialog boxes, the ok to continue and find the keys and the close now to exit the vbs and not run it.
                         
                        And with an option to save the uppcumming keys to a Text file (Example: Keys.txt on Desktop    c:\Desktop\Keys.txt)

                        Thanks
                        <message edited by bushmaoribob on Friday, March 02, 2007 2:42 PM>
                         
                        #12
                          Parabellum

                          • Total Posts : 256
                          • Scores: 4
                          • Reward points : 0
                          • Joined: 11/12/2006
                          • Location: UK
                          • Status: offline
                          RE: Retrieve Windows Product Key Tuesday, March 06, 2007 12:12 PM (permalink)
                          0
                          bushmaoribob: Yes everything you asked for is possible at the moment though i'm very busy.. and hardly getting time to sort my own scripts..
                          Do you know any vbs??? if so have you tried making any of the changes yourself.. I would be happy to try and advise (when i get chance!) 
                           
                          #13
                            bushmaoribob

                            • Total Posts : 5
                            • Scores: 0
                            • Reward points : 0
                            • Joined: 3/1/2007
                            • Status: offline
                            RE: Retrieve Windows Product Key Tuesday, March 06, 2007 4:15 PM (permalink)
                            0
                            Ohkk lolz, well if you get the time to make the changes it wold be great, just post them on the fourm
                             
                            Im only starting to get into vbs so im just learning so i will try tio make these changes myself when i learn more, lol
                             
                            Thanks heapszz,
                             
                            #14
                              Parabellum

                              • Total Posts : 256
                              • Scores: 4
                              • Reward points : 0
                              • Joined: 11/12/2006
                              • Location: UK
                              • Status: offline
                              RE: Retrieve Windows Product Key Thursday, July 19, 2007 7:13 AM (permalink)
                              0
                              thought i'd post some amedments i made to this script...
                              The new version will find on license info for all computer on domain by retrieving computers from AD, check whether they are alive and switched on, and if so use WMI to retrieve license information, then write the results to an xml file..

                              might be useful to somebody

                               '  ##########################################
                               '  #            #
                               '  #  VBScript to Retrieve a List of Computers from Active  #
                               '  #  Directory, check connectivity and generate a report file #
                               '  #  containing Microsoft Windows Licensing Information.  #
                               '  #            #
                               '  ##########################################
                               '
                               Dim objDomain, strComputer, strADComputer, PC, strKeyPath, strValueName, oReg
                               Dim ADCompList, ActiveCompList, RetrievedKeys
                               Dim IE, oFSO, objShell, strPath, objFile
                               Set IE = CreateObject("InternetExplorer.Application")
                               Set objShell = CreateObject("Wscript.Shell")
                               strPath = Wscript.ScriptFullName
                               Set objFSO = CreateObject("Scripting.FileSystemObject")
                               Set objFile = objFSO.GetFile(strPath)
                               strPath = objFSO.GetParentFolderName(objFile) 
                               With IE
                               .left=200
                               .top=200
                               .height=140
                               .width=250
                               .menubar=0
                               .toolbar=0
                               .statusBar=0
                               .navigate "About:Blank"
                               .visible=1
                               End With
                               'wait a while until IE as finished to load
                               Do while IE.busy
                               loop
                               With IE.document
                               .Open
                               .WriteLn "<html>"
                               .WriteLn "<head>"
                               .WriteLn "<HTA:APPLICATION "
                               .WriteLn "     ID='objNoTitleBar'"
                               .WriteLn "     CAPTION=no"
                               .WriteLn "     SHOWINTASKBAR='NO'"
                               .WriteLn "     BORDER='NONE'"
                               .WriteLn "     APPLICATIONNAME='Please Wait'"
                               .WriteLn "     SCROLL='AUTO'"
                               .WriteLn "     SINGLEINSTANCE='yes'"
                               .WriteLn ">"
                               .WriteLn "</head>"
                               .WriteLn "<body text='#ffffff' bgcolor='#000000'>"
                               .WriteLn "<center>Please Wait....<br /><br />"
                               .WriteLn "<img src='" & strPath & "\ajax-loader.gif' /></center>"
                               .WriteLn "</body>"
                               .WriteLn "</html>"
                               .Close
                               End With
                               ADCompList = Array(0)
                               ' Connect to root of domain
                               Dim rootDSE, domainContainer
                               Set rootDSE = GetObject("[link=http://www.visualbasicscript.com/ldap://RootDSE]LDAP://RootDSE[/link]")
                               domainContainer = rootDSE.Get("defaultNamingContext")
                               Set ObjDomain = GetObject("LDAP://" & domainContainer)
                               ' Enumerate through the domain
                               WorkWithObject(ObjDomain)
                               Sub WorkWithObject(oContainer)
                               Dim oADObject
                               For Each oADObject in oContainer
                               Select Case oADObject.Class
                                Case "computer"
                                 Dim strADComputer
                                 strADComputer = oADObject.cn
                                 ADCompList(UBound(ADCompList)) = strADComputer
                                 ReDim Preserve ADCompList(UBound(ADCompList) + 1)
                                Case "organizationalUnit" , "container"
                                 WorkWithObject(oADObject)
                               End Select
                               Next
                               End Sub
                               ReDim Preserve ADCompList(UBound(ADCompList) - 1)
                               ActiveCompList = Array(0)
                               For Each PC In ADCompList
                               If Reachable(PC) Then
                               ActiveCompList(UBound(ActiveCompList)) = PC
                               ReDim Preserve ActiveCompList(UBound(ActiveCompList) + 1)
                               End If
                               Next
                               ReDim Preserve ActiveCompList(UBound(ActiveCompList) - 1)
                               Set objXMLDoc = CreateObject("Microsoft.XMLDOM") 
                               Set rootEl = objXMLDoc.createElement("Computers")
                               objXMLDoc.appendChild rootEl
                               Dim objCurrNode, objNewNode, objNewText 
                               ' <--------------- Open Registry Key and populate binary data into an array -------------------------->
                               const HKEY_LOCAL_MACHINE = &H80000002 
                               strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
                               strValueName = "DigitalProductId"
                               Dim iValues()
                               On Error Resume Next
                               For Each strComputer In ActiveCompList
                               
                               Set objPCField = objXMLDoc.createElement("PC")
                               rootEl.appendChild(objPCField) 
                               
                               Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
                                    strComputer & "\root\default:StdRegProv")
                               oReg.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,iValues
                               Dim arrDPID
                               arrDPID = Array()
                               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 Product Key -------------------------->
                               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 !!! (Decrypt the base24 encoded binary data)-------------------------->
                               strProductKey = ""
                               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
                               strFinalKey = strProductKey
                               
                               Set objWMIService = GetObject("winmgmts:" _
                               & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
                               Set colOperatingSystems = objWMIService.ExecQuery("select * from Win32_OperatingSystem")
                               For Each objOperatingsystem in colOperatingSystems
                               strOS   = objOperatingsystem.Caption
                               strBuild   = objOperatingsystem.BuildNumber
                               strSerial   = objOperatingsystem.SerialNumber
                               strRegistered  = objOperatingsystem.RegisteredUser
                               Next
                               Set objNewNode = objXMLDoc.createElement("Name") 
                               Set objNewText = objXMLDoc.createTextNode(strComputer) 
                               objPCField.appendChild(objNewNode) 
                               objNewNode.appendChild(objNewText) 
                               Set objNewNode = objXMLDoc.createElement("OS") 
                               Set objNewText = objXMLDoc.createTextNode(strOS) 
                               objPCField.appendChild(objNewNode) 
                               objNewNode.appendChild(objNewText) 
                               
                               Set objNewNode = objXMLDoc.createElement("Build") 
                               Set objNewText = objXMLDoc.createTextNode(strBuild) 
                               objPCField.appendChild(objNewNode) 
                               objNewNode.appendChild(objNewText) 
                               
                               Set objNewNode = objXMLDoc.createElement("PID") 
                               Set objNewText = objXMLDoc.createTextNode(strSerial) 
                               objPCField.appendChild(objNewNode) 
                               objNewNode.appendChild(objNewText) 
                               Set objNewNode = objXMLDoc.createElement("RegisteredTo") 
                               Set objNewText = objXMLDoc.createTextNode(strRegistered) 
                               objPCField.appendChild(objNewNode) 
                               objNewNode.appendChild(objNewText) 
                               Set objNewNode = objXMLDoc.createElement("Key") 
                               Set objNewText = objXMLDoc.createTextNode(strFinalKey) 
                               objPCField.appendChild(objNewNode) 
                               objNewNode.appendChild(objNewText) 
                               Next
                               'Add an XML processing instruction and insert it before the root element
                               Set p=objXMLDoc.createProcessingInstruction("xml","version='1.0'")
                               xmlDoc.insertBefore p,objXMLDoc.childNodes(0)
                               objXMLDoc.Save("report.xml")
                               IE.Quit
                               set IE = Nothing
                               MsgBox("Finished")
                               
                               ' <----------------------- Function to check if computer is switched on and responding to Ping ---------------------->
                               Function Reachable(strComputer)
                               ' On Error Resume Next
                               Dim wmiQuery, objWMIService, objPing, objStatus
                               wmiQuery = "Select * From Win32_PingStatus Where Address = '" & strComputer & "'"
                               Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
                               Set objPing = objWMIService.ExecQuery(wmiQuery)
                               
                               For Each objStatus in objPing
                               If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
                                Reachable = False 'if computer is unreacable, return false
                               Else
                                Reachable = True 'if computer is reachable, return true
                               End If
                               Next
                               End Function
                               
                               

                               
                              I've attached the animated gif i used if anyone needs it!!
                              <message edited by Parabellum on Thursday, July 19, 2007 7:18 AM>
                              Attachment(s)Attachments are not available: Download requirements not met
                               
                              #15
                                dm_4ever

                                • Total Posts : 3712
                                • Scores: 93
                                • Reward points : 0
                                • Joined: 6/29/2006
                                • Location: Orange County, California
                                • Status: offline
                                RE: Retrieve Windows Product Key Thursday, July 19, 2007 1:43 PM (permalink)
                                0
                                Nice update...
                                dm_4ever

                                My philosophy: K.I.S.S - Keep It Simple Stupid
                                Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
                                Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm
                                 
                                #16
                                  abenitez77

                                  • Total Posts : 7
                                  • Scores: 0
                                  • Reward points : 0
                                  • Joined: 10/8/2007
                                  • Status: offline
                                  RE: Retrieve Windows Product Key Friday, November 23, 2007 2:39 PM (permalink)
                                  0
                                  Nice Code!
                                   
                                  How can I Do this with computers in ONLY 3 specific OU's ("MAN01", "YOR01", "STL01") ?
                                   
                                  #17
                                    dedwards2

                                    • Total Posts : 5
                                    • Scores: 0
                                    • Reward points : 0
                                    • Joined: 12/12/2007
                                    • Status: offline
                                    RE: Retrieve Windows Product Key Wednesday, December 12, 2007 5:42 AM (permalink)
                                    0
                                    Howdy,

                                    I need to pull the product IDs from every computer on my domain, and the script you posted on 7/19 sounds like it does exactly that - execpt it's not working for me!

                                    Here's what I've done:

                                    I copied and pasted your code to a file and saved it as get_product_id.vbs.

                                    I double-clicked the file.

                                    I get an invalid syntax error on line 56, this line:
                                    Set rootDSE = GetObject("[link=http://www.visualbasicscript.com/ldap://RootDSE]LDAP://RootDSE[/link]")



                                    This looks like some kind of forum post code gone haywire, putting those link tags in. I poked around the internet looking at other scripts that use rootDSE, and I change that line to:
                                    Set rootDSE = GetObject("LDAP://RootDSE")




                                    Now the script runs, but it doesn't produce any results. A window opens and says Please Wait..., and I see wscript.exe running, but after ~20 minutes, no results appear in the window.

                                    Any idea what I'm doing wrong? Should I be waiting longer?
                                    <message edited by dedwards2 on Wednesday, December 12, 2007 5:47 AM>
                                     
                                    #18
                                      ebgreen

                                      • Total Posts : 9274
                                      • Scores: 172
                                      • Reward points : 0
                                      • Joined: 7/12/2005
                                      • Status: offline
                                      RE: Retrieve Windows Product Key Wednesday, December 12, 2007 5:55 AM (permalink)
                                      0
                                      Please post the contents of get_product_id.vbs and the contents of your script file.
                                      Stop the Help Vampires: http://slash7.com/2006/12/22/vampires/
                                      VB is NOT VB.Net which is NOT VBA which is NOT VBScript
                                       
                                      #19
                                        dedwards2

                                        • Total Posts : 5
                                        • Scores: 0
                                        • Reward points : 0
                                        • Joined: 12/12/2007
                                        • Status: offline
                                        RE: Retrieve Windows Product Key Wednesday, December 12, 2007 12:02 PM (permalink)
                                        0
                                        It is identical to Parabellum's, with the exception of line 56, which looks like it's been altered by the forum with [link][/link] tags, at least in my browser.

                                        Here's the code copied directly from my script file, perhaps I copied something incorrectly:

                                         '  ##########################################
                                         '  #            #
                                         '  #  VBScript to Retrieve a List of Computers from Active  #
                                         '  #  Directory, check connectivity and generate a report file #
                                         '  #  containing Microsoft Windows Licensing Information.  #
                                         '  #            #
                                         '  ##########################################
                                         '
                                         Dim objDomain, strComputer, strADComputer, PC, strKeyPath, strValueName, oReg
                                         Dim ADCompList, ActiveCompList, RetrievedKeys
                                         Dim IE, oFSO, objShell, strPath, objFile
                                         Set IE = CreateObject("InternetExplorer.Application")
                                         Set objShell = CreateObject("Wscript.Shell")
                                         strPath = Wscript.ScriptFullName
                                         Set objFSO = CreateObject("Scripting.FileSystemObject")
                                         Set objFile = objFSO.GetFile(strPath)
                                         strPath = objFSO.GetParentFolderName(objFile) 
                                         With IE
                                         .left=200
                                         .top=200
                                         .height=140
                                         .width=250
                                         .menubar=0
                                         .toolbar=0
                                         .statusBar=0
                                         .navigate "About:Blank"
                                         .visible=1
                                         End With
                                         'wait a while until IE as finished to load
                                         Do while IE.busy
                                         loop
                                         With IE.document
                                         .Open
                                         .WriteLn "<html>"
                                         .WriteLn "<head>"
                                         .WriteLn "<HTA:APPLICATION "
                                         .WriteLn "     ID='objNoTitleBar'"
                                         .WriteLn "     CAPTION=no"
                                         .WriteLn "     SHOWINTASKBAR='NO'"
                                         .WriteLn "     BORDER='NONE'"
                                         .WriteLn "     APPLICATIONNAME='Please Wait'"
                                         .WriteLn "     SCROLL='AUTO'"
                                         .WriteLn "     SINGLEINSTANCE='yes'"
                                         .WriteLn ">"
                                         .WriteLn "</head>"
                                         .WriteLn "<body text='#ffffff' bgcolor='#000000'>"
                                         .WriteLn "<center>Please Wait....<br /><br />"
                                         .WriteLn "<img src='" & strPath & "\ajax-loader.gif' /></center>"
                                         .WriteLn "</body>"
                                         .WriteLn "</html>"
                                         .Close
                                         End With
                                         ADCompList = Array(0)
                                         ' Connect to root of domain
                                         Dim rootDSE, domainContainer
                                         Set rootDSE = GetObject("LDAP://RootDSE")
                                         domainContainer = rootDSE.Get("defaultNamingContext")
                                         Set ObjDomain = GetObject("LDAP://" & domainContainer)
                                         ' Enumerate through the domain
                                         WorkWithObject(ObjDomain)
                                         Sub WorkWithObject(oContainer)
                                         Dim oADObject
                                         For Each oADObject in oContainer
                                         Select Case oADObject.Class
                                         Case "computer"
                                         Dim strADComputer
                                         strADComputer = oADObject.cn
                                         ADCompList(UBound(ADCompList)) = strADComputer
                                         ReDim Preserve ADCompList(UBound(ADCompList) + 1)
                                         Case "organizationalUnit" , "container"
                                         WorkWithObject(oADObject)
                                         End Select
                                         Next
                                         End Sub
                                         ReDim Preserve ADCompList(UBound(ADCompList) - 1)
                                         ActiveCompList = Array(0)
                                         For Each PC In ADCompList
                                         If Reachable(PC) Then
                                         ActiveCompList(UBound(ActiveCompList)) = PC
                                         ReDim Preserve ActiveCompList(UBound(ActiveCompList) + 1)
                                         End If
                                         Next
                                         ReDim Preserve ActiveCompList(UBound(ActiveCompList) - 1)
                                         Set objXMLDoc = CreateObject("Microsoft.XMLDOM") 
                                         Set rootEl = objXMLDoc.createElement("Computers")
                                         objXMLDoc.appendChild rootEl
                                         Dim objCurrNode, objNewNode, objNewText 
                                         ' <--------------- Open Registry Key and populate binary data into an array -------------------------->
                                         const HKEY_LOCAL_MACHINE = &H80000002 
                                         strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
                                         strValueName = "DigitalProductId"
                                         Dim iValues()
                                         On Error Resume Next
                                         For Each strComputer In ActiveCompList
                                         Set objPCField = objXMLDoc.createElement("PC")
                                         rootEl.appendChild(objPCField) 
                                         Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
                                            strComputer & "\root\default:StdRegProv")
                                         oReg.GetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,iValues
                                         Dim arrDPID
                                         arrDPID = Array()
                                         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 Product Key -------------------------->
                                         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 !!! (Decrypt the base24 encoded binary data)-------------------------->
                                         strProductKey = ""
                                         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
                                         strFinalKey = strProductKey
                                         Set objWMIService = GetObject("winmgmts:" _
                                         & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
                                         Set colOperatingSystems = objWMIService.ExecQuery("select * from Win32_OperatingSystem")
                                         For Each objOperatingsystem in colOperatingSystems
                                         strOS   = objOperatingsystem.Caption
                                         strBuild   = objOperatingsystem.BuildNumber
                                         strSerial   = objOperatingsystem.SerialNumber
                                         strRegistered  = objOperatingsystem.RegisteredUser
                                         Next
                                         Set objNewNode = objXMLDoc.createElement("Name") 
                                         Set objNewText = objXMLDoc.createTextNode(strComputer) 
                                         objPCField.appendChild(objNewNode) 
                                         objNewNode.appendChild(objNewText) 
                                         Set objNewNode = objXMLDoc.createElement("OS") 
                                         Set objNewText = objXMLDoc.createTextNode(strOS) 
                                         objPCField.appendChild(objNewNode) 
                                         objNewNode.appendChild(objNewText) 
                                         Set objNewNode = objXMLDoc.createElement("Build") 
                                         Set objNewText = objXMLDoc.createTextNode(strBuild) 
                                         objPCField.appendChild(objNewNode) 
                                         objNewNode.appendChild(objNewText) 
                                         Set objNewNode = objXMLDoc.createElement("PID") 
                                         Set objNewText = objXMLDoc.createTextNode(strSerial) 
                                         objPCField.appendChild(objNewNode) 
                                         objNewNode.appendChild(objNewText) 
                                         Set objNewNode = objXMLDoc.createElement("RegisteredTo") 
                                         Set objNewText = objXMLDoc.createTextNode(strRegistered) 
                                         objPCField.appendChild(objNewNode) 
                                         objNewNode.appendChild(objNewText) 
                                         Set objNewNode = objXMLDoc.createElement("Key") 
                                         Set objNewText = objXMLDoc.createTextNode(strFinalKey) 
                                         objPCField.appendChild(objNewNode) 
                                         objNewNode.appendChild(objNewText) 
                                         Next
                                         'Add an XML processing instruction and insert it before the root element
                                         Set p=objXMLDoc.createProcessingInstruction("xml","version='1.0'")
                                         xmlDoc.insertBefore p,objXMLDoc.childNodes(0)
                                         objXMLDoc.Save("report.xml")
                                         IE.Quit
                                         set IE = Nothing
                                         MsgBox("Finished")
                                         ' <----------------------- Function to check if computer is switched on and responding to Ping ---------------------->
                                         Function Reachable(strComputer)
                                         ' On Error Resume Next
                                         Dim wmiQuery, objWMIService, objPing, objStatus
                                         wmiQuery = "Select * From Win32_PingStatus Where Address = '" & strComputer & "'"
                                         Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
                                         Set objPing = objWMIService.ExecQuery(wmiQuery)
                                         For Each objStatus in objPing
                                         If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
                                         Reachable = False 'if computer is unreacable, return false
                                         Else
                                         Reachable = True 'if computer is reachable, return true
                                         End If
                                         Next
                                         End Function
                                         
                                        <message edited by dedwards2 on Wednesday, December 12, 2007 12:05 PM>
                                         
                                        #20
                                          Online Bookmarks Sharing: Share/Bookmark
                                          Change Page: 123 > | Showing page 1 of 3, messages 1 to 20 of 49

                                          Jump to:

                                          Current active users

                                          There are 0 members and 1 guests.

                                          Icon Legend and Permission

                                          • New Messages
                                          • No New Messages
                                          • Hot Topic w/ New Messages
                                          • Hot Topic w/o New Messages
                                          • Locked w/ New Messages
                                          • Locked w/o New Messages
                                          • Read Message
                                          • Post New Thread
                                          • Reply to message
                                          • Post New Poll
                                          • Submit Vote
                                          • Post reward post
                                          • Delete my own posts
                                          • Delete my own threads
                                          • Rate post

                                          2000-2017 ASPPlayground.NET Forum Version 3.9