ASP WSC Windows Scripting Component

Hot Objects

New

Free

Tell a Friend

Home

Array Sorting Routines

Copy the codes and paste, and save the code as Sort.wsc and run
regsvr32 Sort.wsc
to register as component.

Windows Script Component Code Listing

<?xml version="1.1"?>
<component>
<comment>

Original Code Author: Jim Staricka
Component Author: Michael Harris
Date: December 12, 1999

This component encapsulates the QuickSort and ShellSort
algorithms implemented in VBScript by Jim Staricka.

See Jim's comments in the code regarding the original
sources used for the adaptation.

No changes of any kind have been made to Jim's code.
The routines were simply encapsulated in a component
by Michael Harris for ease of client script use.

========
Modified by: Michael Harris
Date: January 3, 2000
Version: 1.1

The ShellSortArray implementation was replaced with one
adapted from the ShelSort routine at www.vb2themax.com.
The original implementation was flawed.
========

Example VBScript client:

<![CDATA[ to hide from parser...

' On the following benchmark, QuickSort consistently
' outperformed ShellSort by a significant margin (about
' 25% faster).
'
' The test uses an array of the 10000 random
' integers. Both routinmes were tested with identical
' array data.
'
' Performance with real data that is not
' random will probably give different results.

Set oSort = CreateObject("Sort.wsc")
m = 10000
seed = Timer()
ReDim arTest(m-1)
Randomize seed
For n = 0 To UBound(arTest)
arTest(n) = Int((m - 1 + 1) * Rnd + 1)
Next
ascending = "x1<x2"
descending = "x1>x2"
t = Timer()
oSort.QuickSortArray arTest, ascending
MsgBox Timer()-t
Randomize seed 'generate random same order
For n = 0 To UBound(arTest)
arTest(n) = Int((m - 1 + 1) * Rnd + 1)
Next
t = Timer()
oSort.ShellSortArray arTest, ascending
MsgBox Timer()-t

]]>

</comment>
<?component error="true" debug="true"?>

<registration
description="QuickSort and ShellSort"
progid="Sort.WSC"
version="1.00"
classid="{e62131a0-b000-11d3-a82a-444553540000}"
>
</registration>

<public>
<method name="QuickSortArray">
<PARAMETER name="ArrayToSort"/>
<PARAMETER name="TestExpression"/>
</method>
<method name="ShellSortArray">
<PARAMETER name="ArrayToSort"/>
<PARAMETER name="TestExpression"/>
</method>
</public>

<script language="VBScript">
<![CDATA[

Sub QuickSortArray(aData(), strTestRelationship)
'********
' Purpose: Sorts an array using the QucikSort method
'
' Inputs: aData() : the array to be sorted.
' strTestRelationship : a string representation of the boolean relationship of
' two arbitrary array elements, X1 and X2. The relationship
' is true if the elements are in the correct order.
'
' Source: Adapted from a VBA routine for VBScript by Jim Staricka.
' Sorry, I forgot the source of the VBA code.
'
' This routine requires VBScript version 5.
'********

Dim strTestFunction

'Create test function by adding function header and tail
strTestFunction = "Function TestFunction(X1, X2) : TestFunction = " & strTestRelationship & " : End Function"

'Make TestFunction available
ExecuteGlobal strTestFunction

'Now Call QSort
QSort aData, LBound(aData), UBound(aData)

End Sub 'QuickSort

Sub QSort(aData, iaDataMin, iaDataMax)
Dim Temp
Dim Buffer
Dim iaDataFirst
Dim iaDataLast
Dim iaDataMid

iaDataFirst = iaDataMin ' Start current low and high at actual low/high
iaDataLast = iaDataMax

If iaDataMax <= iaDataMin Then Exit Sub ' Error!
iaDataMid = (iaDataMin + iaDataMax) \ 2 ' Find the approx midpoint of the array

Temp = aData(iaDataMid) ' Pick as a starting point (we are making
' an assumption that the data *might* be
' in semi-sorted order already!

Do While (iaDataFirst <= iaDataLast)
'Comparison here
Do While TestFunction(aData(iaDataFirst), Temp)
iaDataFirst = iaDataFirst + 1
If iaDataFirst = iaDataMax Then Exit Do
Loop

'Comparison here
Do While TestFunction(Temp, aData(iaDataLast))
iaDataLast = iaDataLast - 1
If iaDataLast = iaDataMin Then Exit Do
Loop

If (iaDataFirst <= iaDataLast) Then ' if low is <= high then swap
Buffer = aData(iaDataFirst)
aData(iaDataFirst) = aData(iaDataLast)
aData(iaDataLast) = Buffer
iaDataFirst = iaDataFirst + 1
iaDataLast = iaDataLast - 1
End If
Loop

If iaDataMin < iaDataLast Then ' Recurse if necessary
QSort aData, iaDataMin, iaDataLast
End If

If iaDataFirst < iaDataMax Then ' Recurse if necessary
QSort aData, iaDataFirst, iaDataMax
End If

End Sub 'QSort

Sub ShellSortArray(aData(), strTestRelationship)
'********
' Purpose: Sorts an array using the QucikSort method
'
' Inputs: aData() : the array to be sorted.
' strTestRelationship : a string representation of the boolean relationship of
' two arbitrary array elements, X1 and X2. The relationship
' is true if the elements are in the correct order.
'
' Source: Adapted from a VB routine ShellSort from the CodeBank at
' http://www.vb2themax.com written by the vb2themax team
' (D.Esposito, F.Balena, et.al.)
'
' This routine requires VBScript version 5.
'********
Dim value
Dim index, index2
Dim firstEl
Dim distance
Dim numEls
Dim strTestFunction

'Create test function by adding function header and tail
strTestFunction = "Function TestFunction(X1, X2) : TestFunction = " & strTestRelationship & " : End Function"

'Make TestFunction available
Execute strTestFunction
' account for optional arguments
lastEl = UBound(aData)
firstEl = LBound(aData)

numEls = lastEl - firstEl + 1
' find the best value for distance
Do
distance = distance * 3 + 1
Loop Until distance > numEls

Do
distance = distance \ 3
For index = distance + firstEl To lastEl
value = aData(index)
index2 = index
Do While TestFunction(value, aData(index2 - distance))
aData(index2) = aData(index2 - distance)
index2 = index2 - distance
If index2 - distance < firstEl Then Exit Do
Loop
aData(index2) = value
Next
Loop Until distance = 1
End Sub

]]>
</script>

</component>

Bookmark & Links

Link to Us