VB icon

Windows XP Genuine Advantage

Email
Submitted on: 11/5/2017 10:55:07 PM
By: A_X_O 
Level: Beginner
User Rating: Unrated
Compatibility: VbScript (browser/client side)
Views: 263
 
     This VBScript creates the registry entries needed for Windows XP to be validated as genuine. The script also terminates the Windows Genuine Advantage Tool (WGAtray) then deletes it. I wrote this some years ago.
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Windows XP Genuine Advantage
' Description:This VBScript creates the registry entries needed for Windows XP to be validated as genuine. The script also terminates the 
Windows Genuine Advantage Tool (WGAtray) then deletes it. I wrote this some years ago.
' By: A_X_O
'**************************************

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
'********************************************************
'*		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


Other 2 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Beginner category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.