# Simple Ping function VBScript

I was after a ping function that met the following constraints;

• Didn’t use GetObject.
• Didn’t display any command (cmd) prompt.
• Didn’t use a temporary file.

Here is what I found;

```Function ping(node)
Set WshShell = CreateObject("WScript.Shell")
ping = Not CBool(WshShell.Run("ping -n 1 " & node, 0, True))
End Function
```

I was looking at a way to timeout the above ping function after 1 second using threading, but this didn’t quite make it so simple. Whilst ping offers a timeout value if you ping an incorrect hostname it will hang for a little while.

# Decimal to Binary functions in Visual Basic

Here are functions to perform decimal to/from binary conversion.

• CBin – converts a decimal integer to binary string.
• CDeci – converts a binary string to decimal integer.
• CBinS16 – converts a decimal signed integer to 16 bit binary string.
• CdecS16 – converts a 16 bit binary string to decimal signed integer.
```'converts an integer to binary string
Function CBin(ByVal n As Double) As String
If n = 0 Then
CBin = 0
ElseIf n > 0 Then
Dim i As Double
Dim c As Long
i = 2 ^ CLng(Log(n) / Log(2) + 0.1)
Do While i >= 1
c = Fix(n / i)
CBin = CBin & c
n = n - i * c
i = i / 2
Loop
End If
End Function

'converts an integer to binary string, problems for n=64
Function CBinOld(ByVal n As Double) As String
On Error Resume Next 'caters for 0 values
Dim i As Double
i = 2 ^ Int(Log(n) / Log(2))
Do While i >= 1
CBinOld = CBinOld & Fix(n / i)
n = n - i * Fix(n / i)
i = i / 2
Loop
End Function

'converts a binary string to integer
Function CDeci(ByRef s As String) As Double
Dim i As Long
CDeci = 0
For i = 0 To Len(s) - 1
CDeci = CDeci + (Mid\$(s, Len(s) - i, 1) * 2 ^ i)
Next i
End Function

'converts an integer to 16 bit signed binary string
Function CBinS16(ByVal n As Double) As String
Dim i As Double

CBinS16 = vbNullString
If n < -2 ^ 15 Then
CBinS16 = "0"
n = n + 2 ^ 16
i = 2 ^ 14
ElseIf n < 0 Then
CBinS16 = "1"
n = n + 2 ^ 15
i = 2 ^ 14
Else 'not negative
i = 2 ^ 15
End If

Do While i >= 1
CBinS16 = CBinS16 & Fix(n / i)
n = n - i * Fix(n / i)
i = i / 2
Loop
End Function

'converts 16 bit signed binary string to integer
Function CDecS16(ByRef s As String) As Double
Dim i As Long
CDecS16 = 0
For i = 0 To Len(s) - 1
CDecS16 = CDecS16 + (Mid\$(s, Len(s) - i, 1) * 2 ^ i)
Next i
If CDecS16 >= 2 ^ 15 Then 'negative number
CDecS16 = CDecS16 - 2 ^ 16
End If
End Function
```

# SQL Server Quickest way to Insert Multiple Rows with VB

Having to parse huge amounts of data from xml files to an SQL Server database, I needed to greatly optimise my code. Here are some tests to insert 10000 rows into table TABLETESTER.

First, using the standard INSERT INTO without specifying column names. TickCount of 70547.

```For i = 1 To 10000
Connection.Execute "INSERT INTO TABLETESTER VALUES (1, 'abcdefghijklmnopqrstuvwxyz')"
Next i
```

Specifying the column names is actually marginally faster. TickCount of 66782.

```For i = 1 To 100000
Connection.Execute "INSERT INTO TABLETESTER (NUMBERVAL, STRINGVAL) VALUES (1, 'abcdefghijklmnopqrstuvwxyz')"
Next i
```

Removing the optional INTO is a little faster still. TickCount 64843.

```For i = 1 To 100000
Connection.Execute "INSERT TABLETESTER (NUMBERVAL, STRINGVAL) VALUES (1, 'abcdefghijklmnopqrstuvwxyz')"
Next i
```

Now lets try some of the methods to combine multiple inserts.

Bunching multiple statements in a single Execute increases the speed by 2. TickCount 35391.

```For i = 1 To 100000 / 100
s = vbNullString
For j = 1 To 100
s = s & "INSERT TABLETESTER (NUMBERVAL, STRINGVAL) VALUES (1, 'abcdefghijklmnopqrstuvwxyz');"
Next j
Connection.Execute = s
Next i
```

Using UNION ALL increases it by a whopping 10 fold. TickCount 2781.

```For i = 1 To 100000 / 100
s = "INSERT INTO TABLETESTER (NUMBERVAL, STRINGVAL) SELECT  1, 'abcdefghijklmnopqrstuvwxyz'"
For j = 2 To 100
s = s & " UNION ALL SELECT  1, 'abcdefghijklmnopqrstuvwxyz'"
Next j
Connection.Execute = s
Next i
```

Increasing the inner loop count. TickCount 3125.

```For i = 1 To 100000 / 1000
s = "INSERT INTO TABLETESTER (NUMBERVAL, STRINGVAL) SELECT  1, 'abcdefghijklmnopqrstuvwxyz'"
For j = 2 To 1000
s = s & " UNION ALL SELECT  1, 'abcdefghijklmnopqrstuvwxyz'"
Next j
Connection.Execute = s
Next i
```

Decreasing the inner loop count. TickCount 8235.

```For i = 1 To 100000 / 10
s = "INSERT INTO TABLETESTER (NUMBERVAL, STRINGVAL) SELECT  1, 'abcdefghijklmnopqrstuvwxyz'"
For j = 2 To 10
s = s & " UNION ALL SELECT  1, 'abcdefghijklmnopqrstuvwxyz'"
Next j
Connection.Execute = s
Next i
```

SQL Server 2008 has a new method of combining multiple inserts. TickCount 3282.

```For i = 1 To 100000 / 100
s = "INSERT TABLETESTER (NUMBERVAL, STRINGVAL) VALUES (1, 'abcdefghijklmnopqrstuvwxyz')"
For j = 2 To 100
s = s & ", (1, 'abcdefghijklmnopqrstuvwxyz')"
Next j
Connection.Execute = s
Next i
```

Increasing the inner loop count, note 1000 is the maximum allowed. TickCount 2859.

```For i = 1 To 100000 / 1000
s = "INSERT TABLETESTER (NUMBERVAL, STRINGVAL) VALUES (1, 'abcdefghijklmnopqrstuvwxyz')"
For j = 2 To 1000
s = s & ", (1, 'abcdefghijklmnopqrstuvwxyz')"
Next j
Connection.Execute = s
Next i
```

Finally, not a SQL syntax change, but compacting the strings. TickCount 2453.

```For i = 1 To 100000 / 1000
s = "INSERT TABLETESTER (NUMBERVAL,STRINGVAL) VALUES (1,'abcdefghijklmnopqrstuvwxyz')"
For j = 2 To 1000
s = s & ",(1,'abcdefghijklmnopqrstuvwxyz')"
Next j
Connection.Execute = s
Next i
```

So from our original method at 66782 to our optimised method at 2453, we get a 97% speed saving!

# Visual Basic 6 – quickest way to find first/last character in string

When you are parsing large amounts of data, the way you code string matching can make a huge difference. In one case I needed to find if a string was contained within quotes, here are the test results from quickest to slowest.

The test situation was to find if the last character in the string ‘abcdefghijklmnopqrstuvwxyz’ is ‘z’ and iterated 100000000 times.

First, the most intuitive which most would use. TickCount of 49546.

```Right("abcdefghijklmnopqrstuvwxyz", 1) = "z"
```

Function Right takes in a Variant by default, by succeeding it with a dollar sign it accepts Strings by default. TickCount of 22828, a significant saving.

```Right\$("abcdefghijklmnopqrstuvwxyz", 1) = "z"
```

Using the equals sign would be seem the norm, but what if the String Compare function was used. TickCount of 18047.

```StrComp(Right\$("abcdefghijklmnopqrstuvwxyz", 1), "z", vbBinaryCompare) = 0
```

What if Mid was used to extract the last character instead of Right. TickCount of 28391.

```StrComp(Mid\$("abcdefghijklmnopqrstuvwxyz", Len("abcdefghijklmnopqrstuvwxyz"), 1), "z") = 0
```

Now what if we use the In String function. String length binary is faster than standard String length. TickCount of 14516.

```InStrRev("abcdefghijklmnopqrstuvwxyz", "z", -1, vbBinaryCompare) = LenB("abcdefghijklmnopqrstuvwxyz") / 2
```

Finally, with out String length binary. TickCount of 11312.

```InStrRev("abcdefghijklmnopqrstuvwxyz", "z", -1, vbBinaryCompare) = Len("abcdefghijklmnopqrstuvwxyz")
```

So using In String Reverse is 77% faster.

UPDATE next day: Three that I totally forgot about

In String starting at last character, TickCount 11266.

```InStr(Len("abcdefghijklmnopqrstuvwxyz"), "abcdefghijklmnopqrstuvwxyz", "z", vbBinaryCompare) = Len("abcdefghijklmnopqrstuvwxyz")
```

And In String Binary which is naturally fast. TickCount 6672.

```InStrB(LenB("abcdefghijklmnopqrstuvwxyz") - 1, "abcdefghijklmnopqrstuvwxyz", "z", vbBinaryCompare) = LenB("abcdefghijklmnopqrstuvwxyz") - 1
```

So using In String Binary is 70% faster.

# Base64/sexatrigesimal encoding/decoding in VBA/VB6/Visual Basic

Here is an implementation of Base 36 enconding/decoding functions is VB6.

```'Convert positive integer to a base36 string.
Function base36encode(ByRef number As Long) As String

Dim alphabet As String
alphabet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If number = 0 Then
base36encode = "0"
Exit Function
End If
base36encode = vbNullString
Do While number <> 0
base36encode = Mid(alphabet, number Mod 36 + 1, 1) & base36encode
number = number  36
Loop

End Function

'Convert base36 string to positive integer.
Function base36decode(ByRef base36 As String) As Long

Dim alphabet As String
alphabet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

base36decode = InStr(1, alphabet, Right(base36, 1), vbTextCompare) - 1 'get the last character
For i = Len(base36) - 1 To 1 Step -1
base36decode = base36decode + 36 ^ (Len(base36) - i) * (InStr(1, alphabet, Mid(base36, i, 1), vbTextCompare) - 1)
Next i

End Function
```

# eventquery.vbs – ERROR: Unable to execute the query for the…

If you received this error when trying to execute eventquery.vbs the cause is an overflow of events past 32,767 (the maximum capacity of a VB6 Integer). There is a very simple fix for this which is to change the data type from an Integer to a Long (which has a maximum capacity of 2,147,483,647).

In eventquery.vbs, scroll down to line 1700 and 1703 and change both CInt to CLng.
Before;

```        If CInt(objLogs.Item(arrKeyName(intLoopCount))) > 0 Then
strFilterLog = arrKeyName(intLoopCount)
intRecordRangeFrom = 0
intRecordRangeTo = CInt(objLogs.Item(arrKeyName(intLoopCount)))
```

After;

```        If CLng(objLogs.Item(arrKeyName(intLoopCount))) > 0 Then
strFilterLog = arrKeyName(intLoopCount)
intRecordRangeFrom = 0
intRecordRangeTo = CLng(objLogs.Item(arrKeyName(intLoopCount)))
```

# Longest Common Subsequence implemented in VBA (Visual Basic for Applications)

From Wikipedia, The longest common subsequence (LCS) problem is to find the longest subsequence common to all sequences in a set of sequences (often just two).

The following is a VBA implementation of this problem. The following functions are included;

String functions;

• longestCommonSubsequence – calculate an LCS array.
• backTraceUp and backTraceLeft – trace back either defaulting up or left respectively, and find the LCS.
• getDiff – returns the difference of the two strings. The succeeding character of =, – or + indicated if the character was equal, removed or added, respectively.
• passGetDiffOutput – passes the output of getDiff so that =, – or + are now values in a 2 x n array, with indix 0 being equal, indix 1 being removed and indix 2 being added.

Array functions;

• longestCommonSubsequenceArr – calculate an LCS array.
• backTraceUpArr – trace back defaulting up and find the LCS.
• getDiffArr – returns the difference of the two arrays as a 2 x n array, with indix 0 being equal, indix 1 being removed and indix 2 being added.

Common functions;

• max – standard maximum function.
• stringToArray – convert a string to an array for array functions.

Examples;

• exampleString
• exampleArr

Unfortunately, the limitations of VBA makes a dog’s dinner out of what would be some very concise code or, perhaps thatâ€™s just my implementationâ€¦

```Option Explicit

Public Function longestCommonSubsequence(ByRef string1 As String, ByRef string2 As String) As Long()
If string1 = vbNullString Or string2 = vbNullString Then
Exit Function
End If

Dim num() As Long

'define the array, note rows of zeros get added to front automatically
ReDim num(Len(string1), Len(string2))

Dim i As Long, j As Long

For i = 1 To Len(string1)
For j = 1 To Len(string2)
If Mid\$(string1, i, 1) = Mid\$(string2, j, 1) Then
num(i, j) = num(i - 1, j - 1) + 1
Else
num(i, j) = max(num(i - 1, j), num(i, j - 1))
End If
Next j
Next i

longestCommonSubsequence = num
End Function

Sub exampleString()

Dim arr() As Long

Dim string1 As String
Dim string2 As String

string1 = "this is a find the haystack string"
string2 = "this is a replace the needle string"

arr = longestCommonSubsequence(string1, string2)

Dim s As String, t As String
s = backTraceUp(arr, string1, string2, Len(string1), Len(string2))
t = backTraceLeft(arr, string1, string2, Len(string1), Len(string2))
Dim a As String, b As String
a = getDiff(arr, string1, string2, Len(string1), Len(string2))

Dim brr() As Long

brr = passGetDiffOutput(a)
End Sub

Public Function max(ByRef a As Long, ByRef b As Long) As Long
If a >= b Then
max = a
Else
max = b
End If
End Function

'back traces c, defaulting in the up direction
Public Function backTraceUp(ByRef c() As Long, ByRef string1 As String, ByRef string2 As String, ByRef i As Long, ByRef j As Long) As String
If i < 1 Or j < 1 Then
backTraceUp = vbNullString
ElseIf Mid\$(string1, i, 1) = Mid\$(string2, j, 1) Then
'equal characters, save it and then go up and left
backTraceUp = backTraceUp(c, string1, string2, i - 1, j - 1) & Mid\$(string1, i, 1)
Else
'go in the direction of the highest number, defaulting to up
If (c(i, j - 1) > c(i - 1, j)) Then
backTraceUp = backTraceUp(c, string1, string2, i, j - 1)
Else
backTraceUp = backTraceUp(c, string1, string2, i - 1, j)
End If
End If
End Function

'back traces c, defaulting in the left direction
Public Function backTraceLeft(ByRef c() As Long, ByRef string1 As String, ByRef string2 As String, ByRef i As Long, ByRef j As Long) As String
If i < 1 Or j < 1 Then
backTraceLeft = vbNullString
ElseIf Mid\$(string1, i, 1) = Mid\$(string2, j, 1) Then
'equal characters, save it and then go up and left
backTraceLeft = backTraceLeft(c, string1, string2, i - 1, j - 1) & Mid\$(string1, i, 1)
Else
'go in the direction of the highest number, defaulting to left
If (c(i, j - 1) >= c(i - 1, j)) Then
backTraceLeft = backTraceLeft(c, string1, string2, i, j - 1)
Else
backTraceLeft = backTraceLeft(c, string1, string2, i - 1, j)
End If
End If
End Function

'the following function returns a string with indication to what was deleted or added
'proceding character can be;
' = no change
' - deletion
Public Function getDiff(ByRef c() As Long, ByRef stringOld As String, ByRef stringNew As String, ByRef i As Long, ByRef j As Long) As String
If i > 0 Then
If j > 0 Then 'both are greater than zero
'can only do the following comparison when i and j are greater than zero
If Mid\$(stringOld, i, 1) = Mid\$(stringNew, j, 1) Then
getDiff = getDiff(c, stringOld, stringNew, i - 1, j - 1) & Mid\$(stringOld, i, 1) & "="
Else
If i = 0 Then
getDiff = getDiff(c, stringOld, stringNew, i, j - 1) & Mid\$(stringNew, j, 1) & "+"
ElseIf c(i, j - 1) >= c(i - 1, j) Then
getDiff = getDiff(c, stringOld, stringNew, i, j - 1) & Mid\$(stringNew, j, 1) & "+"
ElseIf j = 0 Then
getDiff = getDiff(c, stringOld, stringNew, i - 1, j) & Mid\$(stringOld, i, 1) & "-"
ElseIf c(i, j - 1) < c(i - 1, j) Then
getDiff = getDiff(c, stringOld, stringNew, i - 1, j) & Mid\$(stringOld, i, 1) & "-"
Else
getDiff = vbNullString
End If
End If
Else 'i is is greater than zero
If j = 0 Then
getDiff = getDiff(c, stringOld, stringNew, i - 1, j) & Mid\$(stringOld, i, 1) & "-"
ElseIf c(i, j - 1) < c(i - 1, j) Then
getDiff = getDiff(c, stringOld, stringNew, i - 1, j) & Mid\$(stringOld, i, 1) & "-"
Else
getDiff = vbNullString
End If
End If
Else
If j > 0 Then 'j is  greater than zero
If i = 0 Then
getDiff = getDiff(c, stringOld, stringNew, i, j - 1) & Mid\$(stringNew, j, 1) & "+"
ElseIf c(i, j - 1) >= c(i - 1, j) Then
getDiff = getDiff(c, stringOld, stringNew, i, j - 1) & Mid\$(stringNew, j, 1) & "+"
Else
getDiff = vbNullString
End If
Else 'none are greater than zero
getDiff = vbNullString
End If
End If
End Function

'this function returns the location of the string difference
Public Function passGetDiffOutput(ByRef outputStr As String) As Long()
Dim i As Long
i = 1

Dim typeChr As String

Dim oldi As Long
Dim newi As Long
oldi = 0
newi = 0

Dim toFrom() As Long
Dim toFromCount As Long
toFromCount = -1

Dim typeChrPrev As String
typeChrPrev = vbNullString

Do While i < Len(outputStr)
typeChr = Mid\$(outputStr, i + 1, 1)
Select Case typeChr
Case "="
If typeChr <> typeChrPrev Then

'check if it is comming from a deletion
If typeChrPrev = "-" Then
toFrom(2, toFromCount) = oldi
End If

'check if it is comming from a addition
If typeChrPrev = "+" Then
toFrom(2, toFromCount) = newi
End If
End If

oldi = oldi + 1 'update old index
newi = newi + 1 'update new index
Case "-"
'check if it is comming from a addition
If typeChrPrev = "+" Then
toFrom(2, toFromCount) = newi
End If

oldi = oldi + 1 'update old index
If typeChr <> typeChrPrev Then
toFromCount = toFromCount + 1
ReDim Preserve toFrom(2, toFromCount)
'let old be -1
toFrom(0, toFromCount) = -1
toFrom(1, toFromCount) = oldi
End If
Case "+"
'check if it is comming from a deletion
If typeChrPrev = "-" Then
toFrom(2, toFromCount) = oldi
End If

newi = newi + 1 'update new index
If typeChr <> typeChrPrev Then
toFromCount = toFromCount + 1
ReDim Preserve toFrom(2, toFromCount)
'let new be 1
toFrom(0, toFromCount) = 1
toFrom(1, toFromCount) = newi
End If
End Select

i = i + 2
typeChrPrev = typeChr
Loop

'check if it ended on a deletion or adition
If typeChrPrev = "-" Then
toFrom(2, toFromCount) = oldi
End If

If typeChrPrev = "+" Then
toFrom(2, toFromCount) = newi
End If

passGetDiffOutput = toFrom
End Function

'note, arrays must be single dimension
Public Function longestCommonSubsequenceArr(ByRef array1() As String, ByRef array2() As String) As Long()
On Error Resume Next
If UBound(array1, 2) > 0 Or UBound(array2, 2) > 0 Then 'multidimensional arrays
If Error = vbNullString Then
Exit Function
End If
End If

If UBound(array1) < 0 Or UBound(array2) < 0 Then 'check if arrays are bounded
If Error <> vbNullString Then
Exit Function
End If
End If

Dim num() As Long

'define the array, note rows of zeros get added to front automatically
ReDim num(UBound(array1) + 1, UBound(array2) + 1)

Dim i As Long, j As Long

'note, arrays must always start at indice zero.
For i = 0 To UBound(array1)
For j = 0 To UBound(array2)
If array1(i) = array2(j) Then
num(i + 1, j + 1) = num(i, j) + 1
Else
num(i + 1, j + 1) = max(num(i, j + 1), num(i + 1, j))
End If
Next j
Next i

longestCommonSubsequenceArr = num
End Function

Public Function stringToArray(ByRef str As String) As String()
Dim i As Long
Dim arr() As String
ReDim arr(Len(str) - 1)
For i = 1 To Len(str)
arr(i - 1) = Mid\$(str, i, 1)
Next i
stringToArray = arr
End Function

Sub exampleArr()

Dim string1 As String
Dim string2 As String

string1 = "this is a find the haystack string"
string2 = "this is a replace the needle string"

Dim a1() As String
Dim a2() As String

a1 = stringToArray(string1)
a2 = stringToArray(string2)

Dim c() As Long

c = longestCommonSubsequenceArr(a1, a2)

Dim str() As String

str = backTraceUpArr(c, a1, a2, UBound(a1), UBound(a2))

Dim dif() As String
dif = getDiffArr(c, a1, a2, UBound(a1), UBound(a2))

End Sub

'back traces c, defaulting in the up direction
Public Function backTraceUpArr(ByRef c() As Long, ByRef array1() As String, ByRef array2() As String, ByRef i As Long, ByRef j As Long) As String()
Dim arr() As String
If i < 0 Or j < 0 Then
backTraceUpArr = arr
ElseIf array1(i) = array2(j) Then
'equal characters, save it and then go up and left
arr = backTraceUpArr(c, array1, array2, i - 1, j - 1)
'check the bounding of arr
Dim bound As Long
On Error Resume Next
bound = UBound(arr)
If Error <> vbNullString Then
ReDim arr(0)
arr(0) = array1(i)
Else 'no error
ReDim Preserve arr(bound + 1)
arr(bound + 1) = array1(i)
End If
backTraceUpArr = arr
Else
'go in the direction of the highest number, defaulting to up
If (c(i + 1, j) > c(i, j + 1)) Then
backTraceUpArr = backTraceUpArr(c, array1, array2, i, j - 1)
Else
backTraceUpArr = backTraceUpArr(c, array1, array2, i - 1, j)
End If
End If
End Function

'returns a 2xn array, where
'indice 0 are equal
'indice 1 are deletions
Public Function getDiffArr(ByRef c() As Long, ByRef arrayOld() As String, ByRef arrayNew() As String, ByRef i As Long, ByRef j As Long) As String()
Dim arr() As String
Dim bound As Long
On Error Resume Next
If i >= 0 Then
If j >= 0 Then 'both are greater or equal to zero
'can only do the following comparison when i and j are greater or equal than zero
If arrayOld(i) = arrayNew(j) Then
arr = getDiffArr(c, arrayOld, arrayNew, i - 1, j - 1)
bound = UBound(arr, 2) 'check the bounding of arr
If Error <> vbNullString Then
Err.Clear
ReDim arr(2, 0)
arr(0, 0) = arrayOld(i)
Else 'no error
ReDim Preserve arr(2, bound + 1)
arr(0, bound + 1) = arrayOld(i)
End If
getDiffArr = arr
Else
If i = 0 Then
arr = getDiffArr(c, arrayOld, arrayNew, i, j - 1)
bound = UBound(arr, 2) 'check the bounding of arr
If Error <> vbNullString Then
Err.Clear
ReDim arr(2, 0)
arr(2, 0) = arrayNew(j)
Else 'no error
ReDim Preserve arr(2, bound + 1)
arr(2, bound + 1) = arrayNew(j)
End If
getDiffArr = arr
ElseIf c(i + 1, j - 1 + 1) >= c(i - 1 + 1, j + 1) Then
arr = getDiffArr(c, arrayOld, arrayNew, i, j - 1)
bound = UBound(arr, 2) 'check the bounding of arr
If Error <> vbNullString Then
Err.Clear
ReDim arr(2, 0)
arr(2, 0) = arrayNew(j)
Else 'no error
ReDim Preserve arr(2, bound + 1)
arr(2, bound + 1) = arrayNew(j)
End If
getDiffArr = arr
ElseIf j = 0 Then
arr = getDiffArr(c, arrayOld, arrayNew, i - 1, j)
bound = UBound(arr, 2) 'check the bounding of arr
If Error <> vbNullString Then
Err.Clear
ReDim arr(2, 0)
arr(1, 0) = arrayOld(i)
Else 'no error
ReDim Preserve arr(2, bound + 1)
arr(1, bound + 1) = arrayOld(i)
End If
getDiffArr = arr
ElseIf c(i + 1, j - 1 + 1) < c(i - 1 + 1, j + 1) Then
arr = getDiffArr(c, arrayOld, arrayNew, i - 1, j)
bound = UBound(arr, 2) 'check the bounding of arr
If Error <> vbNullString Then
Err.Clear
ReDim arr(2, 0)
arr(1, 0) = arrayOld(i)
Else 'no error
ReDim Preserve arr(2, bound + 1)
arr(1, bound + 1) = arrayOld(i)
End If
getDiffArr = arr
Else
getDiffArr = arr
End If
End If
Else 'i is is greater or equal to zero
If j = 0 Then
arr = getDiffArr(c, arrayOld, arrayNew, i - 1, j)
bound = UBound(arr, 2) 'check the bounding of arr
If Error <> vbNullString Then
Err.Clear
ReDim arr(2, 0)
arr(1, 0) = arrayOld(i)
Else 'no error
ReDim Preserve arr(2, bound + 1)
arr(1, bound + 1) = arrayOld(i)
End If
getDiffArr = arr
ElseIf c(i + 1, j - 1 + 1) < c(i - 1 + 1, j + 1) Then
arr = getDiffArr(c, arrayOld, arrayNew, i - 1, j)
bound = UBound(arr, 2) 'check the bounding of arr
If Error <> vbNullString Then
Err.Clear
ReDim arr(2, 0)
arr(1, 0) = arrayOld(i)
Else 'no error
ReDim Preserve arr(2, bound + 1)
arr(1, bound + 1) = arrayOld(i)
End If
getDiffArr = arr
Else
getDiffArr = arr
End If
End If
Else
If j >= 0 Then 'j is  greater than zero
If i = 0 Then
arr = getDiffArr(c, arrayOld, arrayNew, i - 1, j)
bound = UBound(arr, 2) 'check the bounding of arr
If Error <> vbNullString Then
Err.Clear
ReDim arr(2, 0)
arr(2, 0) = arrayNew(j)
Else 'no error
ReDim Preserve arr(2, bound + 1)
arr(2, bound + 1) = arrayNew(j)
End If
getDiffArr = arr
ElseIf c(i + 1, j - 1 + 1) >= c(i - 1 + 1, j + 1) Then
arr = getDiffArr(c, arrayOld, arrayNew, i, j - 1)
bound = UBound(arr, 2) 'check the bounding of arr
If Error <> vbNullString Then
Err.Clear
ReDim arr(2, 0)
arr(2, 0) = arrayNew(j)
Else 'no error
ReDim Preserve arr(2, bound + 1)
arr(2, bound + 1) = arrayNew(j)
End If
getDiffArr = arr
Else
getDiffArr = arr
End If
Else 'none are greater than zero
getDiffArr = arr
End If
End If
End Function
```

# Get the parameters/arguments being called to an executable

Lets say you have some program ‘A’ that has no documentation and no help files but is being executed by some program ‘B’. You want to run program ‘A’ is individually, but you need to know what parameters/arguments are being passed from program ‘B’.

The following executable will help. Replace program ‘A’ (temporarily) with the following executable. Once program ‘B’ executes this new program, the parameters will be displayed in a message box.

Source code below;

```    Public Sub main()
Dim msg As String = vbNullString

Dim separators As String = " "
Dim commands As String = Microsoft.VisualBasic.Command()
Dim str() As String = commands.Split(separators.ToCharArray)

Dim i As Long

For i = 0 To UBound(str)
msg = msg & str(i).ToString & vbCr
Next

MsgBox(msg)
End Sub
```