'************************************** ' Name: Windows XP Genuine Advantage ' Description:This VBScript creates the ' registry entries needed for Windows XP t ' o be validated as genuine. The script al ' so terminates the Windows Genuine Advantage Tool (WGAtray) then deletes it. I wrote this some years ago. ' By: A_X_O ' ' ' Inputs:None ' ' Returns:None ' 'Assumes:None ' 'Side Effects:None '************************************** '+++++++++++++++++++++++++++++++++++++++ ' +++++++++++++++++ ' '*************************************** ' ***************** '* Patch WinXP Non-Genuine * '*-------------------------------------- ' ----------------* '* Version 2.0 [FINAL] * '* Designer ----------- * '* Create Date: June 12th 2012 * '* * '*************************************** ' ***************** ' '+++++++++++++++++++++++++++++++++++++++ ' +++++++++++++++++ Dim FSO, WShell Dim PATH_TO_FILE, TEMP_PATH Dim ThisFilePath Dim ThePath, LogFile, Log Dim Clock, Calendar Dim Proc, FileShortPath, RegDone Set FSO = CreateObject("Scripting.FileSystemObject") Set WShell = CreateObject("WScript.Shell") Set TEMP_PATH = FSO.GetSpecialFolder(2) Set SYST_PATH = FSO.GetSpecialFolder(1) ThisFilePath = Wscript.ScriptFullName Set ThePath = FSO.GetFile(ThisFilePath) Const H = "500" Const ForWriting = 2 Const ForAppending = 8 Const TheEventLog = "\WinXP_PatchLog.txt" Const WGA_VAL_TOOL = "\WgaTray.exe" Const REGISTRY_FILE = "\FiXP.Reg": PATH_TO_FILE = ((TEMP_PATH) & (REGISTRY_FILE)) Const HaltWGAMsg = "Process: Success - Halting WGA Validation Tool" Const WGARemoved = "Process: Success - The Windows Genuine Advantage tool has been removed" Const ModifyRegEntries = "Entering Genuine Windows XP data to the registry" Const RegErrMod = "Modifying the registry entries failed..." Const RemoveFailed = "Removal of the windows XP validation tool failed" Const AddRegData = "Success: Registry File Created and Started" Const RetTheResult = "Completed the process, Download and check it if you like - http://go.microsoft.com/fwlink/?linkid=52012" Clock = FormatDateTime(Time,3):Calendar = FormatdateTime(Date,1) 'DD/MM/YYYY LogFile = ((ThePath.ParentFolder)&(TheEventLog)) If FSO.FileExists(LogFile) Then FSO.DeleteFile(LogFile) End If wscript.sleep ((H)*4) Set Log = FSO.CreateTextFile((LogFile), True) With Log .Write "Patching Begun @ "&(Clock)&" On The " &(Calendar) .Close End With strComputer = "." Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set colProcessList = objWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = 'WgaTray.exe'") For Each objProcess in colProcessList objProcess.Terminate() Next Set Proc = FSO.OpenTextFile((LogFile), ForAppending, True) With Proc .Write VBcrlf& (HaltWGAMsg) .Close End With Call SearchAndDestroy(SYST_PATH) Function ModifyRegistry() On Error Resume Next Dim RegArray(20) Dim GenRegFile, RegEntry If FSO.FileExists(REGISTRY_FILE) Then FSO.DeleteFile(REGISTRY_FILE) End If h000 = "Windows Registry Editor Version 5.00" & VBNewLine h001 = VBNullString & VBNewLine h002 = "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\WPAEvents]" & VBNewLine h003 = Chr(34) & "OOBETimer" & Chr(34) & "=hex:ff,d5,71,d6,8b,6a,8d,6f,d5,33,93,fd" & VBNewLine h004 = Chr(34) & "LastWPAEventLogged" & Chr(34) & "=hex:d5,07,05,00,06,00,07,00,0f,00,38,00,24,00,fd,02" & VBNewLine h005 = VBNullString & VBNewLine h006 = "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion]" & VBNewLine h007 = Chr(34) & "CurrentBuild" & Chr(34) & "=" & Chr(34) & "1.511.1 () (Obsolete data - do not use)" & Chr(34) & VBNewLine h008 = Chr(34) & "InstallDate" & Chr(34) & "=dword:427cdd95" & VBNewLine h019 = Chr(34) & "ProductId" & Chr(34) & "=" & Chr(34) & "69831-640-1780577-45389" & VBNewLine h010 = Chr(34) & "DigitalProductId" & Chr(34) & "=hex:a4,00,00,00,03,00,00,00,36,39,38,33,31,2d,36,34,30,2d,\" & VBNewLine h011 = Space(1) & "31,37,38,30,35,37,37,2d,34,35,33,38,39,00,5a,00,00,00,41,32,32,2d,30,30,30,\" & VBNewLine h012 = Space(1) & "30,31,00,00,00,00,00,00,00,00,0d,04,89,b2,15,1b,c4,ee,62,4f,e6,64,6f,01,00,\" & VBNewLine h013 = Space(1) & "00,00,00,00,27,ed,85,43,a2,20,01,00,00,00,00,00,00,00,00,00,00,00,00,00,00,\" & VBNewLine h014 = Space(1) & "00,00,00,00,00,00,00,00,00,00,00,31,34,35,30,34,00,00,00,00,00,00,00,ce,0e,\" & VBNewLine h015 = Space(1) & "00,00,12,42,15,a0,00,08,00,00,87,01,00,00,00,00,00,00,00,00,00,00,00,00,00,\" & VBNewLine h016 = Space(1) & "00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,94,a2,b3,ac" & VBNewLine h017 = Chr(34) & "LicenseInfo" & Chr(34) & "=hex:9e,bf,09,d0,3a,76,a5,27,bb,f2,da,88,58,ce,58,e9,05,6b,0b,82,\" & VBNewLine h018 = "c3,74,ab,42,0d,fb,ee,c3,ea,57,d0,9d,67,a5,3d,6e,42,0d,60,c0,1a,70,24,46,16,\" & VBNewLine h019 = "0a,0a,ce,0d,b8,27,4a,46,53,f3,17" RegArray(0) = h000 :RegArray(1) = h001 :RegArray(2) = h002 :RegArray(3) = h003 :RegArray(4) = h004 RegArray(5) = h005 :RegArray(6) = h006 :RegArray(7) = h007 :RegArray(8) = h008 :RegArray(9) = h009 RegArray(10) = h010 :RegArray(11)= h011 :RegArray(12)= h012 :RegArray(13)= h013 :RegArray(14)= h014 RegArray(15) = h015 :RegArray(16)= h016 :RegArray(17)= h017 :RegArray(18)= h018 :RegArray(19)= h019 Set GenRegFile = FSO.CreateTextFile(PATH_TO_FILE, True) For RegEntry = 0 To UBound(RegArray) GenRegFile.Write(RegArray(RegEntry)) Next Set RegDta = FSO.OpenTextFile((LogFile), ForAppending, True) With RegDta .Write VBcrlf& (AddRegData) .Close End With Set FileShortPath = FSO.GetFile(PATH_TO_FILE) RegDone = FileShortPath.ShortPath Wscript.Sleep ((H)*6): WShell.Run("Regedit.exe " & RegDone), True Set CheckState = FSO.OpenTextFile((LogFile), ForAppending, True) With CheckState .Write VBcrlf& (RetTheResult) .Close End With End Function Function SearchAndDestroy(ByVal FldrLocation) On Error Resume Next Dim SysFolder Dim ProblemFile, ProbFile SysFolder = (FldrLocation) ProblemFile = ((SysFolder)&(WGA_VAL_TOOL)) If FSO.FileExists(ProblemFile) Then FSO.DeleteFile(ProblemFile) Set ProbFile = FSO.OpenTextFile((LogFile), ForAppending, True) With ProbFile .Write VBcrlf& (WGARemoved):.Write VBcrlf& (ModifyRegEntries) .Close End With Else Set ProbFile = FSO.OpenTextFile((LogFile), ForAppending, True) With ProbFile .Write VBcrlf& (RemoveFailed) .Close End With End if Wscript.Sleep ((H)*2): Call ModifyRegistry() End Function