'----------------------------------------------------------------
' This Script Resets the AKVIS Trial Keys
' Options:
'  -s|-silent - Silent Mode, Information Message is Not Displayed
' 
' 2010-03-08: v.1.2a
' Fixed Win XP Keys Processing
' Fixed Outlook Express Key Processing
' Added command option -s
'----------------------------------------------------------------

Option Explicit
On Error Resume Next
const HKEY_CURRENT_USER = &H80000001
const HKEY_LOCAL_MACHINE = &H80000002
const OEnonDelKey1="MigToLWP"
const OEnonDelKey2="MigToLWPVer"
const ATRheader="AKVIS Trial Reset v1.2a Information"
const ATREheader="AKVIS Trial Reset v1.2a Error"
const ATREMsg1=": Processing the Key """
const ATREmsg2=""" Had Fault"
const ATREmsg3=": Deleting the SubKey """
const ATREmsg4=": Deleting the Value """
const ATREmsg5="""In SubKey """

dim TrialKeys	' Number of Found Trial Keys
dim objReg		' Registry
dim strTemp

dim IntRes
dim KeyNames
dim strSubKey
dim ValNames
dim ValTypes
dim strValName
dim FullSubkey
dim SilentMode

SilentMode=False
' Check for Silent Key
if (WScript.Arguments.Count=1) then
	strTemp = ucase(WScript.Arguments.Item(0))
	if (strTemp="-S") or (strTemp="-SILENT") then SilentMode=True
end if

'Connecting to WMI/Registry
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
If (Err.Number <> 0) Then
	MsgBox Err.Number & ": " & Err.Description, vbCritical, ATREheader
	WScript.Quit
End If
TrialKeys=0

' Clean Key "HKEY_CURRENT_USER\Software\Class\CLSID"
CleanCLSID HKEY_CURRENT_USER, "Software\Class\CLSID"
' Delete Values "MigTo…" in "HKEY_CURRENT_USER\Software\Microsoft\Outlook Express\5.0\Shared Settings\Setup"
DeleteOutlookExpress HKEY_CURRENT_USER, "Software\Microsoft\Outlook Express\5.0\Shared Settings\Setup"

' Delete All Values in "HKEY_CURRENT_USER\Software\Classes\VirtualStore\MACHINE\SOFTWARE\Wow6432Node\Licenses" (Win 7 x64)
DeleteAllValues HKEY_CURRENT_USER, "Software\Classes\VirtualStore\MACHINE\SOFTWARE\Wow6432Node\Licenses"
' Delete All Values in "HKEY_CURRENT_USER\Software\Classes\VirtualStore\MACHINE\SOFTWARE\Licenses" (Win 7 x32)
DeleteAllValues HKEY_CURRENT_USER, "Software\Classes\VirtualStore\MACHINE\SOFTWARE\Licenses"
' Delete All Values in "HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Licenses" (Win XP x64)
DeleteAllValues HKEY_LOCAL_MACHINE, "SOFTWARE\Wow6432Node\Licenses"
' Delete All Values in "HKEY_LOCAL_MACHINE\SOFTWARE\Licenses" (Win XP x32)
DeleteAllValues HKEY_LOCAL_MACHINE, "SOFTWARE\Licenses"

' Delete Values "HWID…" in "HKEY_CURRENT_USER\Software\Classes\VirtualStore\MACHINE\SOFTWARE\Wow6432Node\AKVIS" (Win 7 x64)
DeleteHWID HKEY_CURRENT_USER, "Software\Classes\VirtualStore\MACHINE\SOFTWARE\Wow6432Node\AKVIS"
' Delete Values "HWID…" in "HKEY_CURRENT_USER\Software\Classes\VirtualStore\MACHINE\SOFTWARE\AKVIS" (Win 7 x32)
DeleteHWID HKEY_CURRENT_USER, "Software\Classes\VirtualStore\MACHINE\SOFTWARE\AKVIS"
' Delete Values "HWID…" in "HKEY_CURRENT_USER\Software\Classes\VirtualStore\MACHINE\SOFTWARE\Wow6432Node\AKVIS" (Win XP x64)
DeleteHWID HKEY_LOCAL_MACHINE, "SOFTWARE\Wow6432Node\AKVIS"
' Delete Values "HWID…" in "HKEY_CURRENT_USER\Software\Classes\VirtualStore\MACHINE\SOFTWARE\AKVIS" (Win XP x32)
DeleteHWID HKEY_LOCAL_MACHINE, "SOFTWARE\AKVIS"

if (SilentMode=false) then
	If (TrialKeys=0) Then
		strTemp = "Trial Keys Have Not Been Found"
	Else
		strTemp = TrialKeys & " Trial Keys Have Been Deleted"
	End If
	MsgBox strTemp, vbInformation, ATRheader
end if

WScript.Quit

' Subroutines
'-------------------------------------------------
Function CleanCLSID(HKEY_Val, KeyStr)
	' Delete all SubKeys/Values

	IntRes = objReg.EnumKey(HKEY_Val, KeyStr, KeyNames)
	If (IntRes <> 0) Then
		If (IntRes = 2) Then Exit Function
		strTemp=intRes & ATREMsg1 & KeyStr & ATREmsg2
		MsgBox strTemp, vbCritical, ATREheader
		WScript.Quit
	End If

	If Not IsArray(KeyNames) then Exit Function		' Key/Subkeys are not exist

	For each strSubKey In KeyNames
		' Detete Subkeys
		strTemp=KeyStr & "\" & strSubKey
		intRes = objReg.DeleteKey(HKEY_Val, strTemp)
		If (intRes <> 0) Then
			strTemp=intRes & ATREmsg3 & strTemp & ATREmsg2
			MsgBox strTemp, vbCritical, ATREheader
			WScript.Quit
		End If
		TrialKeys=TrialKeys+1
	Next

End Function

Function DeleteOutlookExpress(HKEY_Val, KeyStr)
	' Delete Value, If Name Starts With "MigTo"

	IntRes = objReg.EnumValues(HKEY_Val, KeyStr, ValNames, ValTypes)
	If (IntRes <> 0) Then
		If (IntRes = 2) Then Exit Function
		strTemp=intRes & ATREMsg1 & KeyStr & ATREmsg2
		MsgBox strTemp, vbCritical, ATREheader
		WScript.Quit
	End If
	If Not IsArray(ValNames) then Exit Function		' Key/Values are not exist

	For each strValName In ValNames
		strTemp = Left(strValName,5)
		if ((strTemp = "MigTo") and ((StrValName<>OEnonDelKey1) and (StrValName<>OEnonDelKey2))) then
			' Delete Key
			IntRes=objReg.DeleteValue(HKEY_Val, KeyStr, strValName)
			If (IntRes <> 0) Then
				strTemp=intRes & ATREmsg4 & strValName & ATREmsg5 & KeyStr & ATREmsg2
				MsgBox strTemp, vbCritical, ATREheader
				WScript.Quit
			End If
			TrialKeys=TrialKeys+1
		end if
	Next

End Function

Function DeleteAllValues(HKEY_Val, KeyStr)
	' Delete All Values

	IntRes = objReg.EnumValues(HKEY_Val, KeyStr, ValNames, ValTypes)
	If (IntRes <> 0) Then
		If (IntRes = 2) Then Exit Function
		strTemp=intRes & ATREMsg1 & KeyStr & ATREmsg2
		MsgBox strTemp, vbCritical, ATREheader
		WScript.Quit
	End If
	If Not IsArray(ValNames) then Exit Function		' Key/Values are not exist

	For each strValName In ValNames
		' Delete Key
		IntRes=objReg.DeleteValue(HKEY_Val, KeyStr, strValName)
		If (IntRes <> 0) Then
			strTemp=intRes & ATREmsg4 & strValName & ATREmsg5 & KeyStr & ATREmsg2
			MsgBox strTemp, vbCritical, ATREheader
			WScript.Quit
		End If
		TrialKeys=TrialKeys+1
	Next

End Function

Function DeleteHWID(HKEY_Val, KeyStr)
	' Delete Value, If Name Starts With "HWID", in All SubKeys

	IntRes = objReg.EnumKey(HKEY_Val, KeyStr, KeyNames)
	If (IntRes <> 0) Then
		If (IntRes = 2) Then Exit Function
		strTemp=intRes & ATREMsg1 & KeyStr & ATREmsg2
		MsgBox strTemp, vbCritical, ATREheader
		WScript.Quit
	End If

	If Not IsArray(KeyNames) then Exit Function		' Key/Subkeys are not exist
	For each strSubKey In KeyNames
		' Process Each Subkey
		FullSubkey=KeyStr & "\" & strSubKey
		IntRes = objReg.EnumValues(HKEY_Val, FullSubkey, ValNames, ValTypes)
		If ((IntRes <> 0) and (IntRes <> 2))  Then
			strTemp=intRes & ATREMsg1 & FullSubkey & ATREmsg2
			MsgBox strTemp, vbCritical, ATREheader
			WScript.Quit
		End If
		If ((IntRes = 0) and IsArray(ValNames)) Then
			For each strValName In ValNames
				strTemp = Left(strValName,4)
				If (strTemp = "HWID") then
					' Delete Key
					IntRes=objReg.DeleteValue(HKEY_Val, FullSubkey, strValName)
					If (IntRes <> 0) Then
						strTemp=intRes & ATREmsg4 & strValName & ATREmsg5 & FullSubkey & ATREmsg2
						MsgBox strTemp, vbCritical, ATREheader
						WScript.Quit
					End If
					TrialKeys=TrialKeys+1
				End IF
			Next
		End If
	Next

End Function
