BreadCrumbs: Robots.txt : Visual Basic Script

Visual Basic Script

From Luke Jackson

Revision as of 03:45, 7 November 2010; Ljackson (Talk | contribs)
(diff) ←Older revision | Current revision | Newer revision→ (diff)
Jump to: navigation, search

Onyx Registration Script

Dim oWSHShell
Dim oWSHEnvironment
Dim Processes
Dim Process
Dim isAlive
Dim retCode
Dim RegItm1
Dim RegItm2
Dim CurApp

Set oWSHShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:")
Set Processes = objWMIService.InstancesOf("Win32_Process")
'Set oWSHEnvironment = oWSHShell.Environment("windir")
RegItm1 = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\ProductKey"
RegItm2 = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Setup\ProductKey"

For each Process in Processes  
	'WScript.Echo Process.Name
	'WScript.Echo Process.ProcessId
	Select Case LCase(Process.Name)  
		Case "postershop.exe" 'Onyx ProductionHouse
        		retCode = oWSHShell.Popup(Process.Name & " will Close in 30 seconds.", 30, "Onyx Registration Script", 4 + 16)		
			Select Case retCode
        			case 6, -1
                			Process.Terminate(0) 'Yes or timeout was chosen
        			case 7
                			WScript.quit(1) 'No was chosen
				End Select
	End Select    
Next

Set isAlive = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'Postershop.exe'")

If isAlive.Count = 0 Then
	If keyExists(RegItm1) = True Then oWSHShell.RegDelete RegItm1
	If keyExists(RegItm2) = True Then oWSHShell.RegDelete RegItm2
	WScript.Sleep 20000 'Wait 20 seconds.

	oWSHShell.Run """E:\Onyx Graphics\ProductionHouse\server\Postershop.exe""", 8, False
	WScript.Sleep 30000 'Wait 30 seconds.

	Set isAlive = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'Postershop.exe'")
	If isAlive.Count = 1 Then

		Set Processes = objWMIService.InstancesOf("Win32_Process")
		For each Process in Processes  
			Select Case LCase(Process.Name)  
				Case "postershop.exe" 'Onyx ProductionHouse
					oWSHShell.AppActivate Process.ProcessId
					oWSHShell.SendKeys "{TAB}{ENTER}" 'Close the registration screen.
			End Select    
		Next
	End If
Else
	MsgBox "Onyx is still running. Please close the application and attempt registration again.", vbCritical, "Onyx Registration Script"
	Set oWSHShell = Nothing
	WScript.Quit
End If

Set oWSHShell = Nothing
WScript.Quit

'Start Functions

function KeyExists(byval sKeyPath)
    keyExists= false
    sKeyPath= trim(sKeyPath): if (sKeyPath="") then exit function
    if not (right(sKeyPath, 1)="\") then sKeyPath= sKeyPath & "\"

    on error resume next
        createobject("wscript.shell").regRead sKeyPath

        select case err
           case 0: keyExists= true

           case &h80070002: dim sErrMsg
               sErrMsg= replace(err.description, sKeyPath, "")
               err.clear

               createobject("wscript.shell").regRead "HKEY_ERROR\"
               keyExists= not (sErrMsg=replace(err.description, _
                  "HKEY_ERROR\", ""))
        end select
    on error goto 0
end function