Binaryworld - How to sort string Array using CompareString API ... [ VB -> String ]

CompareString compares two strings and determines which one would come first in an alphabetic sort. Although this function can use a number of different comparisons, by default it conducts a case-sensitive word sort. In a word sort, all symbols except hyphens and apostrophes come before the letter "a" (hyphens and apostrophes are treated differently). The function compares strings by first comparing their first characters, then their second characters, etc. until an unequal pair of characters is found.

CompareString returns the following result if it succeed otherwise returns 0

CSTR_LESS_THAN : The first string is less than the second string (i.e., the first string comes before the second string in alphabetical order).
CSTR_EQUAL : The first string is equal to (but not necessarily identical to) the second string.
CSTR_GREATER_THAN : The first string is greater than the second string.

Click here to copy the following block

Private Declare Function GetThreadLocale Lib "KERNEL32" () As Long

Private Declare Function CompareString Lib "kernel32.dll" Alias "CompareStringA" ( _
    ByVal Locale As Long, _
    ByVal dwCmpFlags As Long, _
    ByVal lpString1 As String, _
    ByVal cchCount1 As Long, _
    ByVal lpString2 As String, _
    ByVal cchCount2 As Long) As Long

Const CSTR_LESS_THAN = 1
Const CSTR_EQUAL = 2
Const CSTR_GREATER_THAN = 3
Const LOCALE_SYSTEM_DEFAULT = &H400
Const LOCALE_USER_DEFAULT = &H800

Const NORM_IGNORECASE = &H1
Const NORM_IGNOREKANATYPE = &H10000
Const NORM_IGNORENONSPACE = &H2
Const NORM_IGNORESYMBOLS = &H4
Const NORM_IGNOREWIDTH = &H20000
Const SORT_STRINGSORT = &H1000

Sub SortStrArray(arrWords() As String, Optional IsAscending As Boolean = True)

  ' Use a case-senitive, string sort comparison method to alphabetically
  ' sort nine words. The sorting method simply compares each possible
  ' pair of words; if a pair is out of alphabetical order, they are switched.
  ' (Compare these results to those from using lstrcmp for the comparison.)

  Dim tempstr As String  ' buffer used to swap strings
  Dim Cnt As Integer, tmpCnt As Integer  ' counter variables
  Dim compval As Long   ' result of comparison
  Dim threadlocale As Long ' locale ID of this thread

  ' Get the locale of this thread (i.e., of this program).
  threadlocale = GetThreadLocale()

  '//Pick a word and compare with all other words in array to decide
  '//correct position in the sorted array
  UB = UBound(arrWords)
  LB = LBound(arrWords)
  For Cnt = LB To UB - 1 ' first string of the pair
    For tmpCnt = Cnt + 1 To UB  ' second string of the pair
      'Compare the two strings.
      compval = CompareString(threadlocale, SORT_STRINGSORT, arrWords(Cnt), _
          Len(arrWords(Cnt)), arrWords(tmpCnt), Len(arrWords(tmpCnt)))

      If IsAscending = True Then
        'If arrWords(cnt) is greater, swap them.
        If compval = CSTR_GREATER_THAN Then
          tempstr = arrWords(Cnt)
          arrWords(Cnt) = arrWords(tmpCnt)
          arrWords(tmpCnt) = tempstr
        End If
      Else
        'If arrWords(cnt) is less, swap them.
        If compval = CSTR_LESS_THAN Then
          tempstr = arrWords(Cnt)
          arrWords(Cnt) = arrWords(tmpCnt)
          arrWords(tmpCnt) = tempstr
        End If
      End If
    Next tmpCnt
  Next Cnt
End Sub

Private Sub Form_Load()
  Dim t, i
  Dim arrWords(1 To 9) As String  ' the words to sort

  ' Load the nine strings into the array.
  arrWords(1) = "donot"
  arrWords(2) = "don't"
  arrWords(3) = "do not"
  arrWords(4) = "AB"
  arrWords(5) = "ab"
  arrWords(6) = "A+B"
  arrWords(7) = "A+B+C"
  arrWords(8) = "0"
  arrWords(9) = "01"

  t = Timer

  '//call 10000 times
  For i = 1 To 10000
    Call SortStrArray(arrWords, True)  '// Ascending order sorting
    'Call SortStrArray(arrWords, False) '// Descending order sorting
  Next

  Debug.Print "***** Time taken : " & Timer - t & " seconds ********"

  '//Display sorted words.
  For Each s In arrWords
    Debug.Print s
  Next
End Sub