Activation Code for Dehkhoda Dictionary

amid.vbs

strComputer = "."
Set objServices = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set objProcessorSet = objServices.ExecQuery("SELECT * FROM Win32_Processor", , 48)
For Each Processor In objProcessorSet
    If Processor.ProcessorId <> Null Then
        ProcessorId = CStr(Processor.ProcessorId)
    End If
    ProcessorId = CStr(Processor.ProcessorId)
Next
MsgBox ProcessorId, vbOKOnly, "Processor.ProcessorId: "
ProcessorIdLength = Len(ProcessorId)
'   var_ret_1 = CLng(ProcessorIdLength)
'   ReDim ProcessorIdRange(0 To CLng(ProcessorIdLength))
'   ProcessorIdLast = ProcessorIdLength - 1
'   For i = 0 To ProcessorIdLast Step 1
'     Counter = Counter + 1
'     Sum34 = Sum34 + 00000034h
'     var_144 = Mid(Sum34+00000034h, CLng(Counter), 1)

'     ProcessorIdRange(4) = ProcessorIdRange(4) + var_26C
'     ecx = var_144
'     If ProcessorIdRange Then
'       If ProcessorIdRange = 1 Then
'         var_ret_5 = CLng(i)
'         var_ret_5 = var_ret_5 - edx+00000014h
'         var_1E0 = var_ret_5
'       End If
'     End If
'     var_B4 = ecx+edx
'     var_19C = var_B4
'     If IsNumeric(var_B4) = 0 Then
'       Asc(var_B4) = Asc(var_B4) + 00015588h
'       var_A0 = Asc(var_B4)+00015588
'     End If
'     var_19C = (var_B4 + global_401B10)
'     var_A0 = var_19C
'     result1 = result1 + Int((Sqr(var_A0) + global_4013A8))
'   Next
ComputerCode = "5422"

For i = 1 To Len(ComputerCode) Step 1
    result = result +  (Int(Sqr(Cint(CStr(Mid(ComputerCode, CLng(i), 2))))) + 39)
Next
ComputerCode = Cint(ComputerCode)
  result = Int(Sqr(ComputerCode)) * result
  result = result + 100
  result = result + Int(Sqr(result))
  result = result - 2
MsgBox result, vbOKOnly, "Activation Code: "

cleaner.vbs

Option Explicit
'On Error Resume Next
Err.Clear


Dim strComputer : strComputer = "."
Dim arrRegAddress : arrRegAddress = Array("HKCU\Software\VB and VBA Program Settings\Moeendic\Setting\lanf","HKCU\Software\VB and VBA Program Settings\Moeendic\Setting\ph","HKCU\Software\VB and VBA Program Settings\Wizard(a)\Order\soon","HKCU\Software\VB and VBA Program Settings\Amiddic\setting\ph","HKCU\Software\VB and VBA Program Settings\Amiddic\setting\lanf","HKCU\Software\VB and VBA Program Settings\Wizard(d)\Order\soon")
Dim arrCatKey : arrCatKey = Array("Software\VB and VBA Program Settings\Amiddic","Software\VB and VBA Program Settings\Moeendic","Software\VB and VBA Program Settings\Wizard(a)","Software\VB and VBA Program Settings\Wizard(d)")
Dim oShell : Set oShell = Wscript.CreateObject("Wscript.Shell")
Dim oReg : Set oReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv") 
Dim filesys : Set filesys = CreateObject("Scripting.FileSystemObject") 

Dim i
Dim strMsg
Dim blnFailed
Dim objRecord 
Dim objDictionary
Dim objRegistry : Set objRegistry = New clsRegistry
Dim blnResult : blnResult = objRegistry.Connect(".")
For i = 0 to UBound(arrRegAddress)
'oShell.RegRead arrRegAddress(i)
'    if Err.number=0 then
'        oShell.RegDelete arrRegAddress(i)
'    end if
Next
For i = 0 to UBound(arrCatKey)
    If blnResult Then
    With objRegistry
    blnResult = .DeleteKey("HKCU", arrCatKey(i), True)
'			If blnResult Then
'				WScript.Echo "Deleted key."
'			Else
'				WScript.Echo "Failed to delete key."
'			End If
    blnResult = .DeleteKey("HKCU", arrCatKey(i), False)
'			If blnResult Then
'				WScript.Echo "Deleted key."
'			Else
'				WScript.Echo "Failed to delete key."
'			End If
    End With
End If
Next


If filesys.FileExists(oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Users\" & oShell.ExpandEnvironmentStrings("%Username%") & "\Servicea.dat") Then 
filesys.DeleteFile (oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Users\" & oShell.ExpandEnvironmentStrings("%Username%") & "\Servicea.dat")
End If 
If filesys.FileExists(oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Documents and Settings\" & oShell.ExpandEnvironmentStrings("%Username%") & "\Servicea.dat") Then 
filesys.DeleteFile (oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Documents and Settings\" & oShell.ExpandEnvironmentStrings("%Username%") & "\Servicea.dat")
End If 
If filesys.FileExists(oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Users\" & oShell.ExpandEnvironmentStrings("%Username%") & "\Serviced.dat") Then 
filesys.DeleteFile (oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Users\" & oShell.ExpandEnvironmentStrings("%Username%") & "\Serviced.dat")
End If 
If filesys.FileExists(oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Documents and Settings\" & oShell.ExpandEnvironmentStrings("%Username%") & "\Serviced.dat") Then 
filesys.DeleteFile (oShell.ExpandEnvironmentStrings("%SYSTEMDRIVE%") & "\Documents and Settings\" & oShell.ExpandEnvironmentStrings("%Username%") & "\Serviced.dat")
End If
If filesys.FileExists(oShell.ExpandEnvironmentStrings("%WINDIR%") & "\system32\embed.dat") Then 
filesys.DeleteFile (oShell.ExpandEnvironmentStrings("%WINDIR%") & "\system32\embed.dat")
End If 
'Environ("windir") & "\system32\embed.dat"
'Global.Path & "\collate\usage.edt"

Sub DeleteSubkeys(HKEY_CURRENT_USER, strKeyPath) 
    oReg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrSubkeys 

    If IsArray(arrSubkeys) Then 
        For i=0 to UBound(arrSubkeys)
            DeleteSubkeys HKEY_CURRENT_USER, strKeyPath & "\" & arrSubkeys(i) 
            MsgBox arrSubkeys(i)
        Next 
    End If 
    oReg.DeleteKey HKEY_CURRENT_USER, strKeyPath 
    MsgBox strKeyPath + " Deleted"
End Sub
'// A registry class to abstract the WMI registry provider
'//	Option Explicit
'//
'//	Dim strMsg
'//	Dim blnResult
'//	Dim blnFailed
'//	Dim objRegistry
'//	Dim objRecord 
'//	Dim objDictionary
'//
'//	Set objRegistry 				= New clsRegistry
'//
'//	blnResult 					= objRegistry.Connect(".")
'//	If blnResult Then
'//		With objRegistry
'//
'//			'// Create key
'//			blnResult 			= .CreateKey("HKCU", "Control Panel\Accessibility\Dummy Key")
'//			If blnResult Then
'//				WScript.Echo "Created key."
'//			Else
'//				WScript.Echo "Failed to create key."
'//			End If
'//
'//			'// Delete key
'//			'// True	Delete sub-keys
'//			'// False	Do not delete sub-keys
'//			blnResult 			= .DeleteKey("HKCU", "Control Panel\Accessibility\Dummy Key", True)
'//			If blnResult Then
'//				WScript.Echo "Deleted key."
'//			Else
'//				WScript.Echo "Failed to delete key."
'//			End If
'//
'//			'// Write value
'//			blnResult 			= .WriteValue("HKCU", "Control Panel\Accessibility", "Dummy Value", "REG_SZ", "Dummy data")
'//			If blnResult Then
'//				WScript.Echo "Created value."
'//			Else
'//				WScript.Echo "Failed to create value."
'//			End If
'//
'//			'// Check value exists
'//			blnResult 			= .ExistValue("HKCU", "Control Panel\Accessibility", "Dummy Value")
'//			If blnResult Then
'//				WScript.Echo "Value exists."
'//			Else
'//				WScript.Echo "Value does not exist."
'//			End If
'//
'//			'// Read value
'//			'// Typically, you would use ExistValue before calling ReadValue
'//			blnResult 			= .ReadValue("HKCU", "Control Panel\Accessibility", "Dummy Value")
'//			If blnResult Then
'//				WScript.Echo "Value is " & .get_RegResult & ", and is of type " & .get_RegValueType
'//			Else
'//				WScript.Echo "Failed to read value."
'//			End If
'//
'//			'// Delete value
'//			blnResult 			= .DeleteValue("HKCU", "Control Panel\Accessibility", "Dummy Value")
'//			If blnResult Then
'//				WScript.Echo "Deleted value."
'//			Else
'//				WScript.Echo "Failed to delete value."
'//			End If
'//
'//			'// Check key exists
'//			blnResult 			= .ExistKey("HKCU", "Control Panel\Accessibility", "Keyboard Response")
'//			If blnResult Then
'//				WScript.Echo "Key exists."
'//			Else
'//				WScript.Echo "Key does not exist."
'//			End If
'//
'//			'// Enumerate key
'//			blnResult 			= .EnumKey("HKCU", "Control Panel\Accessibility")
'//			If blnResult Then
'//				Set objDictionary 	= .get_EnumDict
'//				strMsg			= Empty
'//				For Each objRecord In objDictionary
'//					'// objDictionary(objRecord) is always null string for this method
'//					WScript.Echo "Key name is " & objRecord
'//				Next
'//			Else
'//				WScript.Echo "No sub-keys exist under that key."
'//			End If
'//
'//			'// Enumerate values
'//			blnResult 			= .EnumValues("HKCU", "Control Panel\Accessibility\Keyboard Response")
'//			If blnResult Then
'//				Set objDictionary 	= .get_EnumDict
'//				strMsg			= Empty
'//				For Each objRecord In objDictionary
'//					WScript.Echo "Value is " & objRecord  & ", and is of type " & objDictionary(objRecord)
'//				Next
'//			Else
'//				WScript.Echo "No values exist under that key."
'//			End If
'//
'//			'// Enumerate values and data
'//			blnResult 			= .EnumValuesAndData("HKCU", "Control Panel\Accessibility\Keyboard Response")
'//			If blnResult Then
'//				Set objDictionary 	= .get_EnumDict
'//				strMsg			= Empty
'//				For Each objRecord In objDictionary
'//					'// Ignore '_Stage Number' and '_Stage Description'
'//					If Left(CStr(objRecord), 1) <> "_" Then
'//						If objDictionary(objRecord) = 1024 Then
'//							blnFailed	= True
'//							strMsg 		= strMsg & vbCRLF
'//							strMsg 		= strMsg & String(2, vbTAB)
'//							strMsg 		= strMsg & CStr(objRecord)
'//						End If
'//					End If
'//					WScript.Echo "Value is " & objRecord  & ", data is " & objDictionary(objRecord)
'//				Next
'//			Else
'//				WScript.Echo "No value/data pairs exist under that key."
'//			End If
'//		End With
'// 	End If
'Option Explicit
Class clsRegistry
		'// This class makes it simple to manipulate the registry on the local or a remote computer. 
		'// Internally it uses the WMI StdRegProv class methods.
		'// 
		'// It provides a simpler set of methods than the StdRegProv methods:
		'// 
		'// * Rather than numeric values, this object's methods use string input: For example, "HKLM" instead of 0x80000002.
		'//
		'// * Rather than separate Get...Value() methods for each data type, it provides a single ReadValue() method. 
		'// The get_RegResult property will contain the registry value's data, and the get_RegValueType property
		'// will contain the registry value's data type as a string (e.g. "REG_SZ").
		'// 
		'// * Rather than separate Set...Value() methods for each data type, it provides a single WriteValue() method 
		'// that lets you specify the data type as a string parameter.
		'// 
		'// * The DeleteKey() method provides a DeleteSubKeys parameter. If True, then it will attempt to delete all subkeys 
		'// of the specified subkey.
		'// 
		'// * The ExistKey() and ExistValue() methods return True if the specified key or value exists in a specified subkey, 
		'// or False otherwise.
		'// 
		'// This class also implements the EnumValues(), EnumValuesAndData(), and EnumKey() methods:
		'// 
		'// * The array outputs of these methods are accessible from the EnumResult property, which returns a reference to a 
		'// Scripting.Dictionary object.
		'// 
		'// * After calling the EnumValues() method, the EnumResult dictionary will contain the value names and types. 
		'// The types will be stored as strings (e.g. "REG_SZ").
		'// 
		'// * After calling the EnumValuesAndData() method, the EnumDict dictionary will contain the value names and contents 
		'// of each value.  If a value contains a REG_BINARY, the contents will be a string containing a series of the hex bytes 
		'// in the data (like the registry editor). If a value contains a REG_MULTI_SZ, the multiple strings will be separated 
		'// by a "|" character. This method exists mainly as a quick way for a program to output all of the values in a registry subkey.
		'// 
		'// * After calling the EnumKey() method, the EnumResult dictionary will contain the names of the subkeys. 
		'// The "value" parts of the dictionary will be empty strings.
		'// 
		'// * For JScript, the dictToJSArray() method converts a dictionary to a JScript array.
		Dim REG_SZ
		Dim REG_EXPAND_SZ
		Dim REG_BINARY
		Dim REG_DWORD
		Dim REG_QWORD
		Dim REG_MULTI_SZ
		Dim REG_RESOURCE_LIST
		Dim REG_FULL_RESOURCE_DESCRIPTOR
		Dim REG_RESOURCE_REQUIREMENTS_LIST
		Dim ERR_INVALID_DATA
		Dim SEPARATOR
		Dim g_RegTypes
		Dim g_EnumDict
		Dim g_RegProv
		Dim g_RegResult
		Dim g_RegValueType
		Private Sub Class_Initialize()
			REG_SZ 				= 1
			REG_EXPAND_SZ 			= 2
			REG_BINARY 			= 3
			REG_DWORD 			= 4
			REG_MULTI_SZ 			= 7
			REG_RESOURCE_LIST		= 8
			REG_FULL_RESOURCE_DESCRIPTOR	= 9
			REG_RESOURCE_REQUIREMENTS_LIST	= 10
			REG_QWORD			= 11
			ERR_INVALID_DATA 		= 13
			SEPARATOR 			= "|"
			' Contains constants and some numbers for quick lookup.
			Set g_RegTypes 			= CreateObject("Scripting.Dictionary")
			' Dictionary object for EnumKey() and EnumValues().
			Set g_EnumDict 			= CreateObject("Scripting.Dictionary")
			' Case-insensitive key comparisons.
			g_RegTypes.CompareMode 		= vbTextCompare
			g_EnumDict.CompareMode 		= vbTextCompare
			' Populate the dictionary with needed data.
			With g_RegTypes
				.Add "HKCR",                   &H80000000
				.Add "HKEY_CLASSES_ROOT",      &H80000000
				.Add "HKCU",                   &H80000001
				.Add "HKEY_CURRENT_USER",      &H80000001
				.Add "HKLM",                   &H80000002
				.Add "HKEY_LOCAL_MACHINE",     &H80000002
				.Add "HKEY_USERS",             &H80000003
				.Add "HKEY_CURRENT_CONFIG",    &H80000005
				
				.Add "REG_SZ",                 REG_SZ
				.Add REG_SZ,                   "REG_SZ"
				.Add "REG_EXPAND_SZ",          REG_EXPAND_SZ
				.Add REG_EXPAND_SZ,            "REG_EXPAND_SZ"
				.Add "REG_BINARY",             REG_BINARY
				.Add REG_BINARY,               "REG_BINARY"
				.Add "REG_DWORD",              REG_DWORD
				.Add REG_DWORD,                "REG_DWORD"
				.Add "REG_MULTI_SZ",           REG_MULTI_SZ
				.Add REG_MULTI_SZ,             "REG_MULTI_SZ"
				.Add "REG_QWORD",              REG_QWORD
				.Add REG_QWORD,                "REG_QWORD"
				.Add "REG_RESOURCE_LIST",	REG_RESOURCE_LIST
				.Add REG_RESOURCE_LIST,		"REG_RESOURCE_LIST"
				.Add "REG_FULL_RESOURCE_DESCRIPTOR", REG_FULL_RESOURCE_DESCRIPTOR
				.Add REG_FULL_RESOURCE_DESCRIPTOR,   "REG_FULL_RESOURCE_DESCRIPTOR"
				.Add "REG_RESOURCE_REQUIREMENTS_LIST", REG_RESOURCE_REQUIREMENTS_LIST
				.Add REG_RESOURCE_REQUIREMENTS_LIST,   "REG_RESOURCE_REQUIREMENTS_LIST"
			End With
			' No valid data yet
			g_RegResult = Null
			g_RegValueType = Null
		End Sub
		Private Sub Class_Terminate()
			Set g_EnumDict 			= Nothing
			Set g_RegTypes 			= Nothing
		End Sub
		' PROPERTY get_RegResult()
		' Returns the result data from a registry operation.
		Function get_RegResult()
			get_RegResult 			= g_RegResult
		End Function
		' PROPERTY get_RegValueType()
		' Returns the result data's data type.
		Function get_RegValueType()
			get_RegValueType 		= g_RegValueType
		End Function
		' PROPERTY get_EnumDict()
		' Returns a reference to the dictionary populated by the Enum...() methods.
		Function get_EnumDict()
			Set get_EnumDict 		= g_EnumDict
		End Function
		' METHOD Connect()
		' Connects to the specified computer using WMI; returns True for success,
		' or the WMI error code if it fails. If the computer is already connected,
		' it will not attempt to connect again and will return True.
		Function Connect(ByVal ComputerName)
			Dim Result
			Connect 			= False
			ComputerName = UCase(Trim(ComputerName))
			If Left(ComputerName, 2) = "\\" Then 
				ComputerName 		= Mid(ComputerName, 3)
			End If
			On Error Resume Next
			Set g_RegProv 			= GetObject("winmgmts:{impersonationlevel=impersonate}!//" & ComputerName & "/root/default:StdRegProv")
			Result 				= Err.Number
			On Error GoTo 0
			If Err.Number <> 0 Then
				Exit Function
			End If
			Connect 			= True
		End Function
		' If Condition is True, return TrueValue; otherwise, return FalseValue.
		Function IIf(ByVal Condition, ByVal TrueValue, ByVal FalseValue)
			If Condition Then 
				IIf 			= TrueValue 
			Else 
				IIf 			= FalseValue
			End If
		End Function
		' METHOD CheckAccess()
		' Returns True for success, False for failure.
		' HiveName is a string representing the registry hive (e.g. "HKLM").
		' Required is a numeric value representing the desired access level.
		'	KEY_QUERY_VALUE		1	0x1	Required to query the values of a registry key.
		'	KEY_SET_VALUE		2	0x2	Required to create, delete, or set a registry value.
		'	KEY_CREATE_SUB_KEY	4	0x4	Required to create a subkey of a registry key.
		'	KEY_ENUMERATE_SUB_KEYS	8	0x8	Required to enumerate the subkeys of a registry key.
		'	KEY_NOTIFY		16	0x10	Required to request change notifications for a registry key or for subkeys of a registry key.
		'	KEY_CREATE		32	0x20	Required to create a registry key.
		'	DELETE			65536	0x10000	Required to delete a registry key.
		'	READ_CONTROL		131072	0x20000	Combines the STANDARD_RIGHTS_READ, KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS, and KEY_NOTIFY values.
		'	WRITE_DAC		262144	0x40000	Required to modify the DACL in the object's security descriptor.
		'	WRITE_OWNER		524288	0x80000	Required to change the owner in the object's security descriptor.				
		'
		' If the WMI CheckAccess method succeeded, update g_RegResult.
		Function CheckAccess(ByVal HiveName, ByVal SubKeyName, ByVal Required)
			Dim Result
			Dim blnGranted
			CheckAccess			= False
			Result 				= g_RegProv.CheckAccess(g_RegTypes(HiveName), SubKeyName, Required, blnGranted)
			g_RegResult 			= IIf(Result = 0, blnGranted, Null)
			g_RegValueType 			= Null
			If Result <> 0 Then
				Exit Function
			End If
			CheckAccess 			= True
		End Function
		' METHOD CreateKey()
		' Returns True for success, False for failure.
		' HiveName is a string representing the registry hive (e.g. "HKLM").
		Function CreateKey(ByVal HiveName, ByVal SubKeyName)
			Dim Result
			CreateKey			= False
			Result 				= g_RegProv.CreateKey(g_RegTypes(HiveName), SubKeyName)
			If Result <> 0 Then
				Exit Function
			End If
			CreateKey			= True
		End Function
		' METHOD DeleteKey()
		' Returns True for success, False for failure.
		' HiveName is a string representing the registry hive (e.g. "HKLM").
		' If DeleteSubKeys is True, then the method will attempt to delete all
		' subkeys of the specified subkey before deleting the specified subkey.
		' If DeleteSubKeys is True and the method encounters an error deleting
		' a subkey under the specified subkey, it will abort.
		Function DeleteKey(ByVal HiveName, ByVal SubKeyName, ByVal DeleteSubKeys)
			Dim Result
			Dim strRegSubKey
			Dim strRegKey
			Dim Names
			Dim I
			DeleteKey			= False
			'// If the key isn't present, then DeleteKey will be True!
			'// In order to use ExistKey, we have to split SubKeyName 
			'// at the final '\'. This is imposed on us by the way
			'// that the WMI registry object works.
			'// If there's no backslash in SubKeyName, we have to fail
			I				= InStrRev(SubKeyName, "\")
			If I = 0 Then
				Exit Function
			End If
			strRegSubKey			= Left(SubKeyName, I - 1)
			strRegKey			= Right(SubKeyName, Len(SubKeyName) - I)
			If Not ExistKey(HiveName, strRegSubKey, strRegKey) Then
				DeleteKey		= True
				Exit Function
			End If
			If DeleteSubKeys Then
				Result = g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
				If (Result = 0) And (Not IsNull(Names)) Then
					For I = 0 To UBound(Names)
						DeleteKey = DeleteKey(HiveName, _
						      SubKeyName & "\" & Names(I), DeleteSubKeys)
						If DeleteKey <> 0 Then 
							Exit Function
						End if
					Next
				End If
			End If
			Result = g_RegProv.DeleteKey(g_RegTypes(HiveName), SubKeyName)
			If Result <> 0 Then
				Exit Function
			End If
			DeleteKey			= True
		End Function
		' METHOD WriteValue()
		' Returns True for success, False for failure.
		' HiveName is a string representing the registry hive (e.g. "HKLM").
		' ValueType is a string representing the value's type (e.g. "REG_SZ").
		' If you specify "REG_BINARY" or "REG_MULTI_SZ" for the value type,
		' RegData must contain a safearray (VB array) of data. If you are using
		' JScript, you can use the toVBarray() method to convert the JScript
		' array to a safearray, but keep in mind that it must be a zero-based
		' array with contiguous elements.
		Function WriteValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName, ByVal ValueType, ByRef RegData)
			Dim Result
			WriteValue			= False
			If ValueName = "" Then
				Result 			= g_RegProv.SetStringValue(g_RegTypes(HiveName), _
								SubKeyName, _
								ValueName, _
								RegData)
			Else
				Select Case UCase(ValueType)
					Case "REG_SZ"
						Result 	= g_RegProv.SetStringValue(g_RegTypes(HiveName), _
								SubKeyName, _
								ValueName, _
								RegData)
					Case "REG_EXPAND_SZ"
						Result 	= g_RegProv.SetExpandedStringValue(g_RegTypes(HiveName), _
								SubKeyName, _
								ValueName, _
								RegData)
					Case "REG_BINARY"
						Result 	= g_RegProv.SetBinaryValue(g_RegTypes(HiveName), _
								SubKeyName, _
								ValueName, _
								RegData)
					Case "REG_DWORD"
						Result 	= g_RegProv.SetDWORDValue(g_RegTypes(HiveName), _
								SubKeyName, _
								ValueName, _
								RegData)
					Case "REG_MULTI_SZ"
						Result 	= g_RegProv.SetMultiStringValue(g_RegTypes(HiveName), _
								SubKeyName, _
								ValueName, _
								RegData)
					Case "REG_QWORD"
						Result 	= g_RegProv.SetqWORDValue(g_RegTypes(HiveName), _
								SubKeyName, _
								ValueName, _
								RegData)
					Case Else
						Result 	= ERR_INVALID_DATA
				End Select
			  End If
			If Result <> 0 Then
				Exit Function
			End If
			WriteValue 			= True
		End Function
		' METHOD ExistValue()
		' Returns True if the specified value exists, or False if not.
		Function ExistValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
			Dim Exists
			Dim Result
			Dim Names
			Dim Types
			Dim I
			Exists 				= False
			Result 				= g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
			If (Result = 0) And (Not IsNull(Names)) Then
				For I = 0 To UBound(Names)
					Exists 		= UCase(Names(I)) = UCase(ValueName)
					If Exists Then 
						Exit For
					End If
				Next
			End If
			ExistValue 			= Exists
		End Function
		' METHOD ReadValue()
		' Returns True for success, False for failure.
		' HiveName is a string representing the registry hive (e.g. "HKLM").
		' If the WMI method succeeds, the Result property will contain the
		' registry data and the ValueType property will contain a string
		' representing the data type (e.g. "REG_SZ").
		Function ReadValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
			Dim Result
			Dim Names
			Dim Types
			Dim I
			Dim RegData
			ReadValue			= False
			' If ValueName is blank, retrieve the key's (Default) value (REG_SZ)
			If ValueName = "" Then
				Result 			= g_RegProv.GetStringValue(g_RegTypes(HiveName), SubKeyName, ValueName, RegData)
				If Result = 0 Then
					g_RegResult 	= RegData: g_RegValueType = "REG_SZ"
				Else
					g_RegResult 	= Null: g_RegValueType = Null
				End If
			Else
				Result 			= g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
				If (Result = 0) And (Not IsNull(Names)) Then
					For I = 0 To UBound(Names)
						If UCase(Names(I)) = UCase(ValueName) Then
							Select Case Types(I)
								Case REG_SZ
									Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), _
										SubKeyName, _
										ValueName, _
										RegData)
									g_RegValueType = IIf(Result = 0, g_RegTypes(REG_SZ), Null)
									Exit For
								Case REG_EXPAND_SZ
									Result = g_RegProv.GetExpandedStringValue(g_RegTypes(HiveName), _
										SubKeyName, _
										ValueName, _
										RegData)
									g_RegValueType = IIf(Result = 0, g_RegTypes(REG_EXPAND_SZ), Null)
									Exit For
								Case REG_BINARY
									Result = g_RegProv.GetBinaryValue(g_RegTypes(HiveName), _
										SubKeyName, _
										ValueName, _
										RegData)
									g_RegValueType = IIf(Result = 0, g_RegTypes(REG_BINARY), Null)
									Exit For
								Case REG_DWORD
									Result = g_RegProv.GetDWORDValue(g_RegTypes(HiveName), _
										SubKeyName, _
										ValueName, _
										RegData)
									g_RegValueType = IIf(Result = 0, g_RegTypes(REG_DWORD), Null)
									Exit For
								Case REG_QWORD
									Result = g_RegProv.GetQWORDValue(g_RegTypes(HiveName), _
										SubKeyName, _
										ValueName, _
										RegData)
									g_RegValueType = IIf(Result = 0, g_RegTypes(REG_QWORD), Null)
									Exit For
								Case REG_MULTI_SZ
									Result = g_RegProv.GetMultiStringValue(g_RegTypes(HiveName), _
										SubKeyName, _
										ValueName, _
										RegData)
									g_RegValueType = IIf(Result = 0, g_RegTypes(REG_MULTI_SZ), Null)
									Exit For
								Case Else
									Result = ERR_INVALID_DATA
									g_RegResult = Null
									g_RegValueType = Null
									Exit For
							End Select
						End If
					Next
					g_RegResult 	= IIf(Result = 0, RegData, Null)
				End If
			End If
			If Result <> 0 Then
				Exit Function
			End If
			ReadValue 			= True
		End Function
		' METHOD DeleteValue()
		' Returns True for success, False for failure.
		' HiveName is a string representing the registry hive (e.g. "HKLM").
		Function DeleteValue(ByVal HiveName, ByVal SubKeyName, ByVal ValueName)
			Dim Result
			DeleteValue			= False
			'// If the value isn't present, then DeleteValue will be True!
			If Not ExistValue(HiveName, SubKeyName, ValueName) Then
				DeleteValue		= True
				Exit Function
			End If
			Result 				= g_RegProv.DeleteValue(g_RegTypes(HiveName), SubKeyName, ValueName)
			If Result <> 0 Then
				Exit Function
			End If
			DeleteValue			= True
		End Function
		' METHOD ExistKey()
		' Returns True if the specified subkey exists, or False if not.
		Function ExistKey(ByVal HiveName, ByVal SubKeyName, ByVal KeyName)
			Dim Exists
			Dim Result
			Dim Names
			Dim I
			Exists 				= False
			Result 				= g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
			If (Result = 0) And (Not IsNull(Names)) Then
				For I = 0 To UBound(Names)
					Exists 		= UCase(KeyName) = UCase(Names(I))
					If Exists Then 
						Exit For
					End If
				Next
			End If
			ExistKey 			= Exists
		End Function
		' METHOD EnumKey()
		' Returns True for success, False for failure.
		' Populates the EnumDict dictionary's key names with the subkeys in the
		' specified subkey. The dictionary's value names will be blank strings.
		Function EnumKey(ByVal HiveName, ByVal SubKeyName)
			Dim Result
			Dim Names
			Dim I
			EnumKey 			= False
			Result 				= g_RegProv.EnumKey(g_RegTypes(HiveName), SubKeyName, Names)
			g_EnumDict.RemoveAll
			If (Result = 0) And (Not IsNull(Names)) Then
				For I = 0 To UBound(Names)
					g_EnumDict.Add Names(I), ""
				Next
			End If
			'If Result = 0 Then
			If (Result = 0) And (Not IsNull(Names)) Then
				EnumKey 		= True
			End If
		End Function
		' METHOD EnumValues()
		' Returns True for success, False for failure.
		' Populates the EnumDict property's key/value pairs with
		' the value entries and their corresponding data types.
		Function EnumValues(ByVal HiveName, ByVal SubKeyName)
			Dim Result
			Dim Names
			Dim Types
			Dim I
			EnumValues 			= False
			Result 				= g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
			g_EnumDict.RemoveAll
			If (Result = 0) And (Not IsNull(Names)) Then
				For I = 0 To UBound(Names)
					g_EnumDict.Add Names(I), g_RegTypes(Types(I))
				Next
			End If
			'If Result = 0 Then
			If (Result = 0) And (Not IsNull(Names)) Then
				EnumValues 		= True
			End If
		End Function
		' METHOD EnumValuesAndData()
		' Returns True for success, False for failure.
		' Populates the EnumDict property's key/value pairs with
		' the value entries and their contents. For REG_BINARY and REG_MULTI_SZ
		' values, they will be represented as strings with | separators.
		Function EnumValuesAndData(ByVal HiveName, ByVal SubKeyName)
			Dim Result
			Dim Names
			Dim Types
			Dim I
			Dim RegData
			Dim J
			Dim S
			EnumValuesAndData		= False
			Result 				= g_RegProv.EnumValues(g_RegTypes(HiveName), SubKeyName, Names, Types)
			g_EnumDict.RemoveAll
			If (Result = 0) And (Not IsNull(Names)) Then
				For I = 0 To UBound(Names)
					Select Case Types(I)
						Case REG_SZ
							Result = g_RegProv.GetStringValue(g_RegTypes(HiveName), _
								SubKeyName, _
								Names(I), _
								RegData)
							If Result = 0 Then 
								g_EnumDict.Add Names(I), RegData
							End If
						Case REG_EXPAND_SZ
							Result = g_RegProv.GetExpandedStringValue(g_RegTypes(HiveName), _
								SubKeyName, _
								Names(I), _
								RegData)
							If Result = 0 Then 
								g_EnumDict.Add Names(I), RegData
							End If
						Case REG_BINARY
							Result = g_RegProv.GetBinaryValue(g_RegTypes(HiveName), _
								SubKeyName, _
								Names(I), _
								RegData)
							If Result = 0 Then
								S = ""
								For J = 0 To UBound(RegData)
									S = IIf(S <> "", S & " " & ToHex(RegData(J)), ToHex(RegData(J)))
								Next
								g_EnumDict.Add Names(I), S
							End If
						Case REG_DWORD
							Result = g_RegProv.GetDWORDValue(g_RegTypes(HiveName), _
								SubKeyName, _
								Names(I), _
								RegData)
							If Result = 0 Then 
								g_EnumDict.Add Names(I), RegData
							End If
						Case REG_DQWORD
							Result = g_RegProv.GetQWORDValue(g_RegTypes(HiveName), _
								SubKeyName, _
								Names(I), _
								RegData)
							If Result = 0 Then 
								g_EnumDict.Add Names(I), RegData
							End If
						Case REG_MULTI_SZ
							Result = g_RegProv.GetMultiStringValue(g_RegTypes(HiveName), _
								SubKeyName, _
								Names(I), _
								RegData)
							If Result = 0 Then
								S = ""
								For J = 0 To UBound(RegData)
									S = IIf(S <> "", S & SEPARATOR & RegData(J), RegData(J))
								Next
								g_EnumDict.Add Names(I), S
							End If
						Case Else
							Result = ERR_INVALID_DATA
					End Select
				Next
			End If
			'If Result = 0 Then
			If (Result = 0) And (Not IsNull(Names)) Then
				EnumValuesAndData	= True
			End If
		End Function
		' Returns the byte N in hexadecimal notation with a leading zero.
		Function ToHex(ByVal N)
			ToHex 				= IIf(N < &H10, "0" & Hex(N), Hex(N))
		End Function
End Class

Dehkhoda.vbs

strComputer = "."
Set objServices = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set objProcessorSet = objServices.ExecQuery("SELECT * FROM Win32_Processor", , 48)
For Each Processor In objProcessorSet
    If Processor.ProcessorId <> Null Then
        ProcessorId = CStr(Processor.ProcessorId)
    End If
    ProcessorId = CStr(Processor.ProcessorId)
Next
MsgBox ProcessorId, vbOKOnly, "ProcessorId: "
For i = 1 To Len(ProcessorId) Step 1
    If i <> 0 Then
         ProcessorCode = ProcessorCode & CStr(Asc(CStr(Mid(ProcessorId, CLng(i), 1))))
    End If
Next
MsgBox ProcessorCode, vbOKOnly, "ProcessorCode: "
ProcessorCodeLen = Len(ProcessorCode)
ProcessorCodeLenM8 = ProcessorCodeLen - 8
RemainofProcessorCodeLenM8 = Mid(ProcessorCode, 8, ProcessorCodeLenM8 + 1)
ComputerCode = (CLng(CStr(Mid(ProcessorCode, 1, 8))))
For i = 8 To Len(ProcessorCode) Step 1
    ComputerCode = ComputerCode + Cint(CStr(Mid(ProcessorCode, CLng(i), 1)))
Next
ComputerCode = Trim(ComputerCode)
MsgBox ComputerCode, vbOKOnly, "ComputerCode: "
For i = 1 To Len(ComputerCode) Step 1
    ActivationCode = ActivationCode + Int(Sqr((Cint(CStr(Mid(ComputerCode, CLng(i), 1))) + 5)))
Next
ActivationCode = int(ActivationCode +  (ComputerCode * 2 / 3))
MsgBox ActivationCode, vbOKOnly, "Activation Code: "