by Mike Shaffer (1 Submission)
Category: String Manipulation
Compatability: Visual Basic 3.0
Difficulty: Unknown Difficulty
Date Added: Wed 3rd February 2021
Rating: 
(3 Votes)
Want to sort 5,000 10-byte strings in about 1/10th of a second? This will do it (at least on my PII-233!). The insertion sort manages the same task in about 60 seconds (even when optimized it still took about 15 seconds on the same machine).
Inputs
strList (a string array)
Assumes
Want to sort 5,000 10-byte strings in about 1/10th of a second? This will do it (at least on my PII-233!). The insertion sort manages the same task in about 60 seconds (even when optimized it still took about 15 seconds on the same machine).
Code Returns
strList (the same array - sorted)
API Declarations
VBcodersPublic Function QSort(strList() As String, lLbound As Long, lUbound As Long)
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
'::: :::'
'::: Routine: QSort :::'
'::: Author: Mike Shaffer (after Rod Stephens, et al.) :::'
'::: Date: 21-May-98 :::'
'::: Purpose: Very fast sort of a string array :::'
'::: Passed: strList String array :::'
'::: lLbound Lower bound to sort (usually 1) :::'
'::: lUbound Upper bound to sort (usually ubound()) :::'
'::: Returns: strList (in sorted order) :::'
'::: Copyright: Copyright *c* 1998, Mike Shaffer :::'
'::: ALL RIGHTS RESERVED WORLDWIDE :::'
'::: Permission granted to use in any non-commercial :::'
'::: product with credit where due. For free :::'
'::: commercial license contact [email protected] :::'
'::: Revisions: 22-May-98 Added and then dropped revision :::'
'::: using CopyMemory rather than the simple swap :::'
'::: when it was found to not provide much benefit. :::'
'::: :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
Dim strTemp As String
Dim strBuffer As String
Dim lngCurLow As Long
Dim lngCurHigh As Long
Dim lngCurMidpoint As Long
lngCurLow = lLbound ' Start current low and high at actual low/high
lngCurHigh = lUbound
If lUbound <= lLbound Then Exit Function ' Error!
lngCurMidpoint = (lLbound + lUbound) \ 2 ' Find the approx midpoint of the array
strTemp = strList(lngCurMidpoint) ' Pick as a starting point (we are making
' an assumption that the data *might* be
' in semi-sorted order already!
Do While (lngCurLow <= lngCurHigh)
Do While strList(lngCurLow) < strTemp
lngCurLow = lngCurLow + 1
If lngCurLow = lUbound Then Exit Do
Loop
Do While strTemp < strList(lngCurHigh)
lngCurHigh = lngCurHigh - 1
If lngCurHigh = lLbound Then Exit Do
Loop
If (lngCurLow <= lngCurHigh) Then ' if low is <= high then swap
strBuffer = strList(lngCurLow)
strList(lngCurLow) = strList(lngCurHigh)
strList(lngCurHigh) = strBuffer
'
lngCurLow = lngCurLow + 1 ' CurLow++
lngCurHigh = lngCurHigh - 1 ' CurLow--
End If
Loop
If lLbound < lngCurHigh Then ' Recurse if necessary
QSort strList(), lLbound, lngCurHigh
End If
If lngCurLow < lUbound Then ' Recurse if necessary
QSort strList(), lngCurLow, lUbound
End If
End Function