VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



TurboSort

by Brian Cidern (4 Submissions)
Category: String Manipulation
Compatability: Visual Basic 3.0
Difficulty: Beginner
Date Added: Wed 3rd February 2021
Rating: (14 Votes)


Sort arrays much faster with a better string
swapping routine!



Wow, I couldn't believe all the rewrites of the
same sorting routines in VBC. "Look at
mine", "No, use mine", yadda, yadda, yadda. They
all use the horribly slow:


vTemp = String1
String1 = String2
String1 = vTemp



Geezzzz - When you have to sort 30,000+ strings
this is slllooooowwwwwww.



Here's a solution. It uses the the same sorting
routine (or choose your own), but implements a much
faster swap routine using the CopyMemory() API. Now,
instead of swapping strings, which in my case could
be up to 9,000 characters, you are only swapping a
4 byte memory address.



Rock On!!


Assumes
Create a new EXE and throw in Command1 - Paste the rest.

Rate TurboSort

Option Explicit
Private Declare Sub CopyMemory _
 Lib "kernel32" _
 Alias "RtlMoveMemory" ( _
 lpDest As Any, _
 lpSource As Any, _
 ByVal cbCopy As Long _
 )
Private Sub Command1_Click()
 ' Sort an array with CopyMemory()
 Dim i As Integer
 Dim str_Unsorted As String, _
 str_Sorted As String
 
 ' Populate some sample data
 Dim vArray(25) As String
 vArray(0) = "EFGHIJKLMNOPQRSTUVWXYZABCD"
 vArray(1) = "RSTUVWXYZABCDEFGHIJKLMNOPQ"
 vArray(2) = "PQRSTUVWXYZABCDEFGHIJKLMNO"
 vArray(3) = "DEFGHIJKLMNOPQRSTUVWXYZABC"
 vArray(4) = "IJKLMNOPQRSTUVWXYZABCDEFGH"
 vArray(5) = "ZABCDEFGHIJKLMNOPQRSTUVWXY"
 vArray(6) = "HIJKLMNOPQRSTUVWXYZABCDEFG"
 vArray(7) = "LMNOPQRSTUVWXYZABCDEFGHIJK"
 vArray(8) = "STUVWXYZABCDEFGHIJKLMNOPQR"
 vArray(9) = "TUVWXYZABCDEFGHIJKLMNOPQRS"
 vArray(10) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 vArray(11) = "CDEFGHIJKLMNOPQRSTUVWXYZAB"
 vArray(12) = "VWXYZABCDEFGHIJKLMNOPQRSTU"
 vArray(13) = "MNOPQRSTUVWXYZABCDEFGHIJKL"
 vArray(14) = "FGHIJKLMNOPQRSTUVWXYZABCDE"
 vArray(15) = "JKLMNOPQRSTUVWXYZABCDEFGHI"
 vArray(16) = "YZABCDEFGHIJKLMNOPQRSTUVWX"
 vArray(17) = "XYZABCDEFGHIJKLMNOPQRSTUVW"
 vArray(18) = "OPQRSTUVWXYZABCDEFGHIJKLMN"
 vArray(19) = "BCDEFGHIJKLMNOPQRSTUVWXYZA"
 vArray(20) = "GHIJKLMNOPQRSTUVWXYZABCDEF"
 vArray(21) = "KLMNOPQRSTUVWXYZABCDEFGHIJ"
 vArray(22) = "NOPQRSTUVWXYZABCDEFGHIJKLM"
 vArray(23) = "WXYZABCDEFGHIJKLMNOPQRSTUV"
 vArray(24) = "QRSTUVWXYZABCDEFGHIJKLMNOP"
 vArray(25) = "UVWXYZABCDEFGHIJKLMNOPQRST"
 
 ' Here's the unsorted array
 For i = 0 To UBound(vArray)
 str_Unsorted = str_Unsorted & vArray(i) & vbCrLf
 Next i
 MsgBox str_Unsorted
 
 ' Sort the array
 SortMe vArray
 
 ' Here's the sorted array
 For i = 0 To UBound(vArray)
 str_Sorted = str_Sorted & vArray(i) & vbCrLf
 Next i
 MsgBox str_Sorted
 
 
End Sub
Sub SortMe(varArray() As String)
 Dim i As Long, j As Long
 Dim l_Count As Long
 Dim l_Hold As Long
 
 ' Typical sorting routine
 l_Count = UBound(varArray)
 For i = 0 To l_Count
 For j = i + 1 To l_Count
 If varArray(i) > varArray(j) Then
 ' Here's the juice!
 SwapStrings varArray(i), varArray(j)
 End If
 Next
 Next
End Sub
Sub SwapStrings(pbString1 As String, pbString2 As String)
 Dim l_Hold As Long
 CopyMemory l_Hold, ByVal VarPtr(pbString1), 4
 CopyMemory ByVal VarPtr(pbString1), ByVal VarPtr(pbString2), 4
 CopyMemory ByVal VarPtr(pbString2), l_Hold, 4
End Sub

Download this snippet    Add to My Saved Code

TurboSort Comments

No comments have been posted about TurboSort. Why not be the first to post a comment about TurboSort.

Post your comment

Subject:
Message:
0/1000 characters