VB6 string array sort

Auric__

2012-07-16 00:28:49 UTC

Post by scbs29
Can anyone advise me of a sort array for the following.
I have files in a folder, the names of whic I pick up within my
program using the Dir() function, eg
Dim intFiles As Integer
Dim strFile As String
intFiles = 0
strFile = Dir(strFolder)
Do While strFile <> vbNullString
If strFile <> "." And strFile <> ".." Then
intFiles = intFiles + 1
ReDim Preserve strFileNames(intFiles)
strFileNames(intFiles - 1) = strFolder &
strFile
End If
strFile = Dir
Loop
In explorer the filenames are listed as

[snip]

Post by scbs29
but when I retrieve and display the filenames they are listed as

[snip]

Post by scbs29
How can I sort these names so that they are in the same order as sjown
in explorer ?
I have tried a lot of sort algorithms I have found through DuckDuckGo
but none of them do the job.
Can anyone help ?
Will I have to write my own sort algorithm ?

Short version: yes.

Long version: For pretty much all generic sorting algorithms, "10" < "2"
because the leftmost character of the strings are "1" and "2". With Windows
XP, Microsoft altered Explorer's sort algorithm to recognize numbers and
sort them appropriately, so it recognizes that "10" > "2". (Windows 2000
and older sort the way you don't want.)

To sort appropriately, your sorter would need to do something like this:

Sub custom_sorter(ByRef what() As String)
'variation of bubble sort
Dim L0 As Long, L1 As Long, f1 As Long, f2 As Long
Dim n1 As Double, n2 As Double, altered As Boolean
Do
altered = False
For L0 = LBound(what) To UBound(what) - 1
If what(L0) <> what(L0 + 1) Then
f1 = InStrAny(1, what(L0), "0123456789")
f2 = InStrAny(1, what(L0 + 1), "0123456789")
If f1 <> f2 Then
'numbers not in same position
If what(L0) > what(L0 + 1) Then
Swap what(L0), what(L0 + 1)
altered = True
End If
Else
'numbers in the same position;
'is the part before the numbers the same?
If Left(what(L0), f1 - 1) <> Left(what(L0 + 1), f1 - 1) Then
'left parts don't match; numbers don't matter
If what(L0) > what(L0 + 1) Then
Swap what(L0), what(L0 + 1)
altered = True
End If
Else
'text matches; numbers matter now
For L1 = f1 + 1 To Len(what(L0))
Select Case Mid(what(L0), L1, 1)
Case "0" To "9", "."
'do nothing
Case Else
n1 = Val(Mid(what(L0), f1, L1 - f1))
Exit For
End Select
Next
For L1 = f1 + 1 To Len(what(L0 + 1))
Select Case Mid(what(L0 + 1), L1, 1)
Case "0" To "9", "."
'do nothing
Case Else
n2 = Val(Mid(what(L0 + 1), f1, L1 - f1))
Exit For
End Select
Next
If n1 > n2 Then
Swap what(L0), what(L0 + 1)
altered = True
End If
End If
End If
End If
Next
Loop While altered
End Sub

'-----support functions-----

Function InStrAny(start As Integer, lookin As String, _
lookfor As String) As Long
Dim tmp1 As Long, L0 As Long

For L0 = start To Len(lookin)
tmp1 = InStr(lookfor, Mid$(lookin, L0, 1))
If tmp1 Then
InStrAny = L0
Exit Function
End If
Next
End Function

Sub Swap(ByRef var1, ByRef var2)
If VarType(var1) <> VarType(var2) Then Exit Sub
Dim tmp
tmp = var1
var1 = var2
var2 = tmp
End Sub

You're welcome to use the above in your project if you want, but you should
make sure it actually does what you want. (You should also note that bubble
sort is just about the slowest sort algorithm, and my code is slower than a
"normal" bubble sort.)

--
Hallo. My nem eez Inigo Montoya. You keel my father. Prepare to die.