38956

getfiles_key.vbs ' Backup/Get OEMBIOS Files & create a basic windows answer file (winnt.sif) ' WinNT: XP ' Author: 38956 ' This script is based on "Bezalel" scripts on the MSFN Forum ' ( URL: http://www.msfn.org/board/topic/63258-building-a-pre-activated-cd-from-an-existing-installation/ ) ' 21110112.3 - 09:53 Zulu Dim objFSO, objShell Dim strXPKey Set objShell = CreateObject("WScript.Shell") '//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '// Functions: GetKey(rpk) '// '// Credit where credit is due - I found this script posted by user "Bezalel" on MSFN Forum '// ( URL: http://www.msfn.org/board/topic/63258-building-a-pre-activated-cd-from-an-existing-installation/ ) '// and used it here to retrieve the windows product key: strXPKey = objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName") If Len(strXPKey) > 0 Then Function GetKey(rpk) Const rpkOffset=52:i=28 szPossibleChars="BCDFGHJKMPQRTVWXY2346789" Do dwAccumulator=0 : j=14 Do dwAccumulator=dwAccumulator*256 dwAccumulator=rpk(j+rpkOffset)+dwAccumulator rpk(j+rpkOffset)=(dwAccumulator\24) and 255 dwAccumulator=dwAccumulator Mod 24 j=j-1 Loop While j>=0 i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey if (((29-i) Mod 6)=0) and (i<>-1) then i=i-1 : szProductKey="-"&szProductKey End If Loop While i>=0 GetKey=szProductKey End Function End If set objFSO = CreateObject("Scripting.FileSystemObject") If Not objFSO.FolderExists(".\OEMBIOS") Then set objFolderOEMBIOS = objFSO.CreateFolder(".\OEMBIOS") End If If Not objFSO.FolderExists(".\OEMBIOS\i386") Then set objFolderi386 = objFSO.CreateFolder(".\OEMBIOS\i386") End If objShell.Run "cmd /c attrib -s %SystemRoot%\system32\CatRoot\{F750E6C3-38EE-11D1-85E5-00C04FC295EE}\OEMBIOS.CAT & makecab %SystemRoot%\system32\CatRoot\{F750E6C3-38EE-11D1-85E5-00C04FC295EE}\OEMBIOS.CAT /L .\OEMBIOS\i386 & attrib +s %SystemRoot%\system32\CatRoot\{F750E6C3-38EE-11D1-85E5-00C04FC295EE}\OEMBIOS.CAT & makecab %SystemRoot%\system32\OEMBIOS.BIN /L .\OEMBIOS\i386 & makecab %SystemRoot%\system32\OEMBIOS.DAT /L .\OEMBIOS\i386 & makecab %SystemRoot%\system32\OEMBIOS.SIG /L .\OEMBIOS\i386" Set fso = CreateObject("Scripting.FileSystemObject") Set winntsif = fso.OpenTextFile(".\OEMBIOS\i386\winnt.sif", 2, True) winntsif.WriteLine "[UserData]" winntsif.WriteLine "ProductKey=" & chr(34) & GetKey(objShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId")) & chr(34) winntsif.WriteLine "[Data]" winntsif.WriteLine "MSDosInitiated=0" winntsif.WriteLine "UnattendedInstall=Yes"

Manufacturer: Dell Computer Corporation Model: OptiPlex GX150 Manufacturer (hex): 44656C6C 20436F6D 70757465 7220436F 72706F72 6174696F 6E Hex to String Converter: http://chxo.com/scripts/hex2string.php strComputer = "." Dim Act, ComputerReport, Fso, Dtop, Report, Ts Set Act = CreateObject("Wscript.Shell") Set Fso = CreateObject("Scripting.FileSystemObject") Dtop = Act.SpecialFolders("Desktop") Set Ts = Fso.CreateTextFile(Dtop & "\ComputerReport.txt") Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set colComputer = objWMIService.ExecQuery("Select * from Win32_ComputerSystem") For Each objComputer In colComputer MfgHex="" For i=1 To Len(objComputer.Manufacturer) MfgHex=MfgHex & Hex(Asc(Mid(objComputer.Manufacturer,i,1))) If i Mod 4 = 0 then MfgHex=MfgHex & " " Next ComputerReport = (vbCrLf & space(3) & "Manufacturer: " & objComputer.Manufacturer & vbCrLf &_ space(3) & "Model: " & objComputer.Model & vbCrLF & vbCrLf & space(3) & "Manufacturer (hex): " & vbCrLf & space(3)& MfgHex) Next Ts.WriteLine ComputerReport : Ts.Close Act.Run(Chr(34)& Dtop & "\ComputerReport.txt" & Chr(34)),1,True