Code-a-holic: UPX

Showing posts with label UPX. Show all posts

Thursday, December 20, 2007

[Visual BASIC 6] BOOST (v2)

I revisited BOOST this week. A friend had pointed out to me some time back that /P: and /L: were a bit of a pain when one wanted to speed something up quickly, or kill it quickly. So this version changes the command line handling.

This version also demonstrates how to kill a process. In fact it kills every process of the same name. I wish I'd had this a couple of years ago when I was doing stuff with Excel -- I'd end up with multiple Excel sessions which I would then have to kill off one-by-one through the Task Manager. (I eventually ended up installing Cygwin so that I could script the process.)

If you remember the original VBScript of BOOST and the first VB6 version, you'll see some similarities.

I've given up on using setsubsys in favour of using VBAdvance (which is now freeware) to handle the compile-to-console-app process. I'm still compressing the app using UPX.

First a few constants and the declarations, found on vb.mvps.org, for doing console I/O.

Option Explicit

Const KILL_PROCESS = 0             '0
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

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

Next, a few supporting functions. First off the rank, is an invocation syntax display. Notice that priority can now be specified either by a number (0 to kill, 1-6 for low to realtime) or by name (kill, low, belownormal, normal, abovenormal, high, realtime).

Sub Syntax()
    ConsoleWrite ("Syntax:" & vbNewLine & _
        vbTab & "Boost {processname} {runlevel}" & vbNewLine & _
        "Run level as number:" & vbNewLine & _
            vbTab & "0 = KILL_PROCESS" & 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 & vbNewLine & vbNewLine & _
                    "Run level as text:" & vbNewLine & _
            vbTab & "kill = KILL_PROCESS" & vbNewLine & _
            vbTab & "low = LOW_PRIORITY" & vbNewLine & _
            vbTab & "belownormal = BELOWNORMAL_PRIORITY" & vbNewLine & _
            vbTab & "normal = NORMAL_PRIORITY" & vbNewLine & _
            vbTab & "abovenormal = ABOVENORMAL_PRIORITY" & vbNewLine & _
            vbTab & "high = HIGH_PRIORITY" & vbNewLine & _
            vbTab & "realtime = REALTIME_PRIORITY" & vbNewLine)
    
End Sub

Second, the command line parser. This splits on space and tab and is based on code found at microsoft.public.vb.winapi

Function GetCommandLine(Optional MaxArgs) As Variant
   'Declare variables.
   Dim C As String
   Dim CmdLine As String
   Dim CmdLnLen As Integer
   Dim InArg As Boolean
   Dim i As Integer
   Dim NumArgs As Integer
   Dim ArgArray As Variant
   'See if MaxArgs was provided.
   If IsMissing(MaxArgs) Then MaxArgs = 10
   'Make array of the correct size.
   ReDim ArgArray(MaxArgs - 1)
   NumArgs = 0: InArg = False
   'Get command line arguments.
   CmdLine = Command()
   CmdLnLen = Len(CmdLine)
   'Go thru command line one character
   'at a time.
   For i = 1 To CmdLnLen
      C = Mid(CmdLine, i, 1)
      'Test for space or tab.
      If (C <> " " And C <> vbTab) Then
         'Neither space nor tab.
         'Test if already in argument.
         If Not InArg Then
         'New argument begins.
         'Test for too many arguments.
            If NumArgs = MaxArgs Then Exit For
            NumArgs = NumArgs + 1
            InArg = True
         End If
         'Concatenate character to current argument.
         ArgArray(NumArgs - 1) = ArgArray(NumArgs - 1) & C
      Else
         'Found a space or tab.
         'Set InArg flag to False.
         InArg = False
      End If
   Next i
   'Resize array just enough to hold arguments.
   ReDim Preserve ArgArray(NumArgs - 1)
   'Return Array in Function name.
   GetCommandLine = ArgArray '()
End Function

Third, the two routines which wrap the WMI functions to set priority and to kill process. The latter was found at tek-tips. If I remember correctly, the places in each routine where it says

sComputer = "."

could, in fact, have some other computer's name. If you had sufficient privilege you could be tweaking or killing a process on someone else's machine.

Function SetPriority(sProcess As String, nPriority As Integer) As Boolean
    Dim sComputer As String
    Dim oWMIService As Object
    Dim cProcesses As Object
    Dim oProcess As Object
    Dim bDone As Boolean
    
    bDone = False
    sComputer = "."
    Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")

    On Error Resume Next
    Set cProcesses = oWMIService.ExecQuery _
        ("Select * from Win32_Process Where Name = '" & sProcess & "'")
    For Each oProcess In cProcesses
        oProcess.SetPriority (nPriority)
        If Err.Number <> 0 Then
            GoTo DoNext
        End If
        bDone = True
DoNext:
    Next
    On Error GoTo 0
    SetPriority = bDone
End Function

Function KillProcess(sProcess As String) As Integer
    Dim oWMIService As Object
    Dim sComputer As String
    Dim oProcess As Object
    Dim nDone As Integer
    
    nDone = 0
    sComputer = "." 'this computer
    Set oWMIService = GetObject("winmgmts:")

    For Each oProcess In oWMIService.InstancesOf("Win32_process")
        If LCase(oProcess.Name) = LCase(sProcess) Then
            oProcess.Terminate
            nDone = nDone + 1
        End If
    Next
    KillProcess = nDone
End Function

Finally, the Main subroutine. Notice the additions to the priorities collection. Note also the change in the way the command line is handled.

Because there's no .Exists method on Collections, the .Item call is wrapped in an 'On Error' so that a non-existent item situation is caught appropriately.

Sub Main()
    
    Dim sLevel As String
    Dim nLevel As Integer
    Dim sProcess As String
    Dim sCommand As String
    Dim nInstances As Integer
    
    Dim dPriorities As New Collection
        
    dPriorities.Add Item:=KILL_PROCESS, Key:="kill"
    dPriorities.Add Item:=LOW_PRIORITY, Key:="low"
    dPriorities.Add Item:=BELOWNORMAL_PRIORITY, Key:="belownormal"
    dPriorities.Add Item:=NORMAL_PRIORITY, Key:="normal"
    dPriorities.Add Item:=ABOVENORMAL_PRIORITY, Key:="abovenormal"
    dPriorities.Add Item:=HIGH_PRIORITY, Key:="high"
    dPriorities.Add Item:=REALTIME_PRIORITY, Key:="realtime"
    
    dPriorities.Add Item:=KILL_PROCESS, Key:="0"
    dPriorities.Add Item:=LOW_PRIORITY, Key:="1"
    dPriorities.Add Item:=BELOWNORMAL_PRIORITY, Key:="2"
    dPriorities.Add Item:=NORMAL_PRIORITY, Key:="3"
    dPriorities.Add Item:=ABOVENORMAL_PRIORITY, Key:="4"
    dPriorities.Add Item:=HIGH_PRIORITY, Key:="5"
    dPriorities.Add Item:=REALTIME_PRIORITY, Key:="6"
    
    Dim aArgs As Variant
    
    If Command() = "" Then
        Syntax
        End
    End If
    
    aArgs = GetCommandLine(2)
    sProcess = aArgs(0)
    sLevel = aArgs(1)
    
    If sProcess = "" Or sLevel = "" Then
        Syntax
        End
    End If

    On Error Resume Next
    nLevel = dPriorities.Item(sLevel)
    If Err.Number = 5 Then
        ConsoleWrite "Invalid selection of runlevel." & vbNewLine
        Syntax
        End
    End If
    On Error GoTo 0
    If nLevel = 0 Then
        nInstances = KillProcess(sProcess)
        If nInstances = 0 Then
            ConsoleWrite "No instances of " & sProcess & " found to kill" & vbNewLine
        Else
            ConsoleWrite nInstances & " " & IIf(nInstances > 1, "instances", "instance") & " of " & sProcess & " killed." & vbNewLine
        End If
    Else
        ConsoleWrite sProcess & IIf(SetPriority(sProcess, nLevel), _
            " boosted", " NOT boosted") & _
            " to priority " & sLevel & " (" & nLevel & ")." & vbNewLine
    End If

End Sub

What's next with this thing? I suppose one could explore the possibility of influencing the lives of applications on other computers:

BOOST Skype.exe kill /C:GUEST_01

There's also the fact that the commandline parser doesn't properly handle double-quoted names. If an .exe had a space it its name, you wouldn't be able use BOOST on it.

Finally, here's a short batch file (killall.bat) I use for killing applications en masse. It was originally designed to get around the 'typing the /P and /L' issue, but I'm so used to using it now ...

 @echo off
:loop
if %1@==@ goto done
c:\bin\boost %1 kill
shift
goto loop
:done

An example invocation:

killall excel.exe outlook.exe

© Copyright Bruce M. Axtens, 2007

Monday, May 07, 2007

[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."