[Visual Basic 6] Boost again, but as a binary

As nice as the VBScript version of BOOST is, some people prefer a compiled binary. So, here's the VB6 version.

But first, credit where credit is due:
* Ultimate Packer for eXecutables which compresses binaries;
* Euphoria programming language website for the SETSUBSYS tool which I use to turn a GUI applications into a console ones;
* Experts Exchange for their ParseCommandLineValue function; and
* vb.mvps.org for their sample on how to make console applications

Okay, now to the code. The algorithm is very similar to the VBScript project, but there are some new things.

First the constants:

Option Explicit Const LOW_PRIORITY = 64 '1 Const BELOWNORMAL_PRIORITY = 16384 '2 Const NORMAL_PRIORITY = 32 '3 Const ABOVENORMAL_PRIORITY = 32768 '4 Const HIGH_PRIORITY = 256 '5 Const REALTIME_PRIORITY = 128 '6

Here are two functions vital to making the application function appropriately in a command line environment. The first discovers the handle for StdOut. The second writes to a file handle, in this case the handle for StdOut.

After the function declarations is a user-defined wrapper. Interesting how the output of the WriteFile function is transmitted to the return value of the wrapper (the last argument in the call is the name of the wrapper function -- I'd never seen that before.)

'http://vb.mvps.org/samples/project.asp?id=console Private Declare Function GetStdOutHandle Lib "kernel32" _ Alias "GetStdHandle" _ (Optional ByVal HandleType As Long = -11) As Long Private Declare Function WriteFile Lib "kernel32" _ (ByVal hFile As Long, _ ByVal lpBuffer As String, _ ByVal cToWrite As Long, _ ByRef cWritten As Long, _ Optional ByVal lpOverlapped As Long) As Long 'To keep things simple, wrap these two APIs in a single helper function like so: Private Function ConsoleWrite(sText As String) As Long WriteFile GetStdOutHandle, ByVal sText, Len(sText), ConsoleWrite End Function

This is the SetPriority function pulled straight out of the VBScript project. Notice I haven't even been polite enough to VB6 to specify sProcess As String and nPriority As Integer. I haven't typed any of the variables local to the function either. It doesn't matter: VB6 types them all as Variant and takes care of my carelessness (and I have put them in since.)

Function SetPriority(sProcess, nPriority) Dim sComputer Dim oWMIService Dim cProcesses Dim oProcess Dim bDone bDone = False sComputer = "." Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2") Set cProcesses = oWMIService.ExecQuery _ ("Select * from Win32_Process Where Name = '" & sProcess & "'") For Each oProcess In cProcesses oProcess.SetPriority (nPriority) bDone = True Next SetPriority = bDone End Function

Next comes the Experts Exchange code for parsing the command line.

'http://www.experts-exchange.com/Programming/Programming_Languages/Q_20832956.html#9992009 Public Function ParseCommandLineValue(ByVal sCommandLine As String, ByVal sKey As String) As String Dim lPosFrom As Integer Dim lPosLen As Integer Dim sValue As String 'Initialize ParseCommandLineValue = "" If Trim(sKey) = "" Then Err.Raise vbObjectError, "Invalid key" End If 'Get Datasource lPosFrom = InStr(1, sCommandLine, sKey, vbTextCompare) If lPosFrom > 0 Then 'Find the position of the Value after length of the Key lPosFrom = lPosFrom + Len(sKey) 'Get value sValue = Mid(sCommandLine, lPosFrom) 'till end 'Find where next value starts lPosLen = InStr(lPosFrom, sCommandLine, "/") If lPosLen > 0 Then 'last value of the command line lPosLen = lPosLen - lPosFrom Else 'more values after this one lPosLen = Len(sValue) End If 'Return sValue = Mid(sCommandLine, lPosFrom, lPosLen) ParseCommandLineValue = sValue End If End Function

Now the Main. For ease of access to the relevant values for the SetPriority function, I've used a Collection. I could have used VBScript's Dictionary (by adding a reference to SCRRUN.DLL in the Projects menu) but the Collection works well enough.

Sub Main() 'http://vb.mvps.org/samples/project.asp?id=console Dim sLevel As String Dim nLevel As Integer Dim sProcess As String Dim sCommand As String Dim cPriorities As New Collection cPriorities.Add LOW_PRIORITY, "1" cPriorities.Add BELOWNORMAL_PRIORITY, "2" cPriorities.Add NORMAL_PRIORITY, "3" cPriorities.Add ABOVENORMAL_PRIORITY, "4" cPriorities.Add HIGH_PRIORITY, "5" cPriorities.Add REALTIME_PRIORITY, "6"

Now we parse the commandline and output a message about syntax if things aren't correctly specified there.

sCommand = Command() sProcess = Trim(ParseCommandLineValue(sCommand, "/process:")) sLevel = Trim(ParseCommandLineValue(sCommand, "/level:")) If sProcess = "" Or sLevel = "" Then ConsoleWrite ("Syntax:" & vbNewLine & _ vbTab & "Boost /process:{processname} /level:{runlevel}" & vbNewLine & _ "Run levels:" & vbNewLine & _ vbTab & "1 = LOW_PRIORITY" & vbNewLine & _ vbTab & "2 = BELOWNORMAL_PRIORITY" & vbNewLine & _ vbTab & "3 = NORMAL_PRIORITY" & vbNewLine & _ vbTab & "4 = ABOVENORMAL_PRIORITY" & vbNewLine & _ vbTab & "5 = HIGH_PRIORITY" & vbNewLine & _ vbTab & "6 = REALTIME_PRIORITY" & vbNewLine) End End If

Assuming that the commandline is okay, we then attempt to figure out the runlevel value from the user-supplied specification, and show an appropriate error if it doesn't make sense.

On Error Resume Next nLevel = cPriorities.Item(sLevel) If Err.Number = 5 Then ConsoleWrite ("Invalid selection of runlevel.") End End If On Error GoTo 0

And, finally, where it is all made to happen. If everything's set up right and there is in fact a process running that matches what's stored in sProcess, then it gets boosted and the user is informed. If there's no match, the message says that the process wasn't boosted.

ConsoleWrite (sProcess & IIF(SetPriority(sProcess, nLevel), _ " boosted", " not boosted") & " to priority " & sLevel & _ " (" & nLevel & ").") End Sub

Having compiled the code to an .EXE, I used the setsubsys tool to change the binary from a GUI app to a console app

setsubsys boost.exe /C

I also compressed it using UPX,

upx -9 boost.exe

taking a 24576 byte application and leaving me with an 8192 byte one.

If anyone's interested in downloading the BOOST binary (which now contains a KILL_PROCESS 'level'), please leave a comment to that effect and I'll put up a download link.

By the way, if you think my code sucks, say so. Critiques are always welcome. King Solomon said, "The wise person accepts instructions." and also "Better is open rebuke than hidden love."