BreadCrumbs: Visual Basic Script

Visual Basic Script

From Luke Jackson

(Difference between revisions)
Jump to: navigation, search

Revision as of 19:50, 6 November 2010

Onyx Registration Script

Dim oWSHShell Dim oWSHEnvironment Dim Processes Dim Process Dim isAlive Dim retCode Dim RegItm1 Dim RegItm2 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 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 30000 'Wait 30 seconds. oWSHShell.Run """E:\Onyx Graphics\ProductionHouse\server\Postershop.exe""", 8, False WScript.Sleep 30000 'Wait 30 seconds. oWSHShell.SendKeys "{TAB}{ENTER}" 'Close the registration screen. 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

Personal tools