Ok, the results are in. The following is about as fast as pure VB6 code is going to get a string array sorted.
I had already worked out swapping of BSTR pointers so the BSTR strings didn't need to be moved or copied to get this done. However, thanks go out to VanGoghGaming for suggesting aliasing all these BSTR pointers with a Long array so that we don't need lots of GetMem4 calls. It turns out that just doing Long variable assignments is quite a bit faster than calls to GetMem4.
There's another thread found here that compares the speeds of several methods of sorting string arrays, and the following is the clear winner.
As a note, if you need to do something like sort a UDT array based on some string item, the following code isn't what you want. This code is highly optimized for specifically sorting a single dimension string array.
This method is recursive, but it's still fairly memory efficient, as the BSTR strings are never copied.
I haven't made an attachment, as it's easy enough to copy-paste. Ideally, you'd want to place both procedures (the Public one and the Private one) in a BAS module somewhere.
If anyone thinks they can do this faster, bounce over to this thread and give it a go. I'll work your method into the timings with the other attempts.
I had already worked out swapping of BSTR pointers so the BSTR strings didn't need to be moved or copied to get this done. However, thanks go out to VanGoghGaming for suggesting aliasing all these BSTR pointers with a Long array so that we don't need lots of GetMem4 calls. It turns out that just doing Long variable assignments is quite a bit faster than calls to GetMem4.
There's another thread found here that compares the speeds of several methods of sorting string arrays, and the following is the clear winner.
As a note, if you need to do something like sort a UDT array based on some string item, the following code isn't what you want. This code is highly optimized for specifically sorting a single dimension string array.
This method is recursive, but it's still fairly memory efficient, as the BSTR strings are never copied.
I haven't made an attachment, as it's easy enough to copy-paste. Ideally, you'd want to place both procedures (the Public one and the Private one) in a BAS module somewhere.
Code:
Option Explicit
'
Private Declare Function ArrPtr Lib "msvbvm60.dll" Alias "VarPtr" (a() As Any) As Long
Private Declare Function StrArrPtr Lib "msvbvm60.dll" Alias "__vbaRefVarAry" (StringArray As Variant) As Long ' Just pass string array as argument (NOT variant).
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
'
Public Sub RecursiveSortStringsEx(ByRef ToBeSorted() As String)
' A recursive quicksort. But nowhere are strings actually copied or moved, so it's memory efficient and fast.
' This just gets things going. A call to LocalRecursiveSortStrings does the actual sorting.
' The array is completely validated, and this procedure returns if it's not a valid one-dimension string array with data.
'
' Get ToBeSorted() string array's SafeArray pointer, and make sure we've got an array.
Dim pSaToSort As Long ' Pointer to ToBeSorted's SafeArray structure.
pSaToSort = StrArrPtr(ToBeSorted) ' String arrays are weird so we must use this alternate API call.
If pSaToSort = 0& Then Exit Sub ' No array found.
CopyMemory pSaToSort, ByVal pSaToSort, 4& ' Dereference pointer.
If pSaToSort = 0& Then Exit Sub ' No array found.
Dim cDims As Integer ' And now check to make sure we just have one dimension.
CopyMemory cDims, ByVal pSaToSort, 2& ' Get number of dimensions in string array.
If cDims <> 1 Then Exit Sub ' Not a ONE dimensional array.
'
' Make sure it's not a 0 to -1 array.
If UBound(ToBeSorted) < LBound(ToBeSorted) Then Exit Sub
'
' Get pointer to temp Long array that we'll be using to alias our string array BSTR pointers.
Static lAlias(0&) As Long ' Array we'll borrow SafeArray from. Static for a bit of speed.
Static bb(23&) As Byte ' A place to store the original SafeArray for lAlias so we can fix it when we're done. Static just for a bit of speed.
Dim pSaAlias As Long ' Pointer to pSaAlias's SafeArray.
pSaAlias = ArrPtr(lAlias) ' Get pointer to pointer.
CopyMemory pSaAlias, ByVal pSaAlias, 4& ' Dereference pointer.
CopyMemory bb(0&), ByVal pSaAlias, 24& ' Make copy of lAlias's original SafeArray so we can restore it.
'
' And now, let's do the actual alias of the Long array's SafeArray onto the String array's SafeArray.
CopyMemory ByVal pSaAlias, ByVal pSaToSort, 24&
'
' We're now ready to sort, using our lAlias array for swapping.
LocalRecursiveSortStrings ToBeSorted, LBound(ToBeSorted), UBound(ToBeSorted), lAlias
'
' And restore our lAlias's SafeArray so memory isn't corrupted.
CopyMemory ByVal pSaAlias, bb(0&), 24&
End Sub
Private Sub LocalRecursiveSortStrings(ByRef ToBeSorted() As String, ByVal TheLeft As Long, ByVal TheRigt As Long, ByRef lAlias() As Long)
' This is a recursive quicksort (but must be called from RecursiveSortStringsEx).
'
Static i As Long, j As Long, t As Long ' Static so we don't pile up local recursive variables.
Static sPivot As String, pPivot As Long ' Static so we don't pile up local recursive variables.
If TheLeft < TheRigt Then
CopyMemory pPivot, ByVal VarPtr(sPivot), 4& ' Save original string pointer.
CopyMemory ByVal VarPtr(sPivot), ByVal VarPtr(ToBeSorted(TheRigt)), 4& ' Alias our pivot string, so we don't have to create another BSTR.
i = TheLeft - 1&
For j = TheLeft To TheRigt - 1&
If ToBeSorted(j) <= sPivot Then
i = i + 1&
t = lAlias(i): lAlias(i) = lAlias(j): lAlias(j) = t ' Swap i & j.
End If
Next
CopyMemory ByVal VarPtr(sPivot), pPivot, 4& ' Cleanup pivot string aliasing.
i = i + 1& ' Set pivot.
t = lAlias(i): lAlias(i) = lAlias(TheRigt): lAlias(TheRigt) = t ' Swap i & TheRigt.
LocalRecursiveSortStrings ToBeSorted, TheLeft, i - 1&, lAlias ' Sort each side of pivot, recursively.
LocalRecursiveSortStrings ToBeSorted, i + 1&, TheRigt, lAlias ' Sort each side of pivot, recursively.
End If
End Sub