Массив в алфавитном порядке?

[13GHOST]

Имеем массив типа String. Нудно все значения этого массива упорядочить в алфавитном порядке. Как?

[GSerg]

Дык видимо отсортировать, нет?
Для начала пузырём?

[xolod]

Ну а я бы предложил QuickSort

[13GHOST]

Чё за QuickSort ?

[tyomitch]

Чё за QuickSort ?

Ну наконец-то у меня появился повод показать эту фишку общественности


Использование системной реализации быстрой сортировки в WinNT

Префейс: в ntdll.dll есть функция qsort, позволяющая быстро отсортировать любой массив. К несчастью, это cdecl-функция; поэтому для работы с ней придётся маленько попотеть.

Код: Выделить всё

Option Explicit

'Private Declare Sub qsort Lib "ntdll" (base As Any, ByVal num As Long, ByVal width As Long, ByVal compare As Long)
'Private Declare Function VarCmp Lib "oleaut32" (ByVal pvarLeft As Variant, ByVal pvarRight As Variant, ByVal lcid As Long, ByVal dwFlags As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal Length As Long)
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpFunc As Long, ByVal Param1 As Long, ByVal Param2 As Long, ByVal Param3 As Long, ByVal Param4 As Long) As Long
Dim hModule1 As Long, EntryPoint As Long
Dim hModule2 As Long, VarCmp As Long
Dim Thunk(0 To 32) As Byte
Dim Comparer(0 To 24) As Byte

Public Sub Initialize()
    hModule1 = LoadLibrary("ntdll")
    EntryPoint = GetProcAddress(hModule1, "qsort")
    hModule2 = LoadLibrary("oleaut32")
    VarCmp = GetProcAddress(hModule2, "VarCmp")
   
    CopyMemory Thunk(0), &H102474FF, 4  'FF742410   push dword ptr [esp+10h]
    CopyMemory Thunk(4), &H102474FF, 4  'FF742410   push dword ptr [esp+10h]
    CopyMemory Thunk(8), &H102474FF, 4  'FF742410   push dword ptr [esp+10h]
    CopyMemory Thunk(12), &H102474FF, 4 'FF742410   push dword ptr [esp+10h]
    CopyMemory Thunk(16), &H6E8, 2      'E806000000 call $+6
    CopyMemory Thunk(21), &H10C483, 3   '83C410     add esp, 10h
    CopyMemory Thunk(24), &H10C2, 2     'C21000     ret 10h
    Thunk(27) = &H68                    '68xxxxxxxx push xxxxxxxx
    CopyMemory Thunk(28), EntryPoint, 4
    Thunk(32) = &HC3                    'C3         ret
   
    Comparer(0) = &H6A                  '6A00       push 0
    Comparer(2) = &H6A                  '6A00       push 0
    CopyMemory Comparer(4), &H102474FF, 4 'FF742410 push dword ptr [esp+10h]
    CopyMemory Comparer(8), &H102474FF, 4 'FF742410 push dword ptr [esp+10h]
    CopyMemory Comparer(12), &H2E8, 2   'E802000000 call $+2
    Comparer(17) = &H48                 '48         dec eax
    Comparer(18) = &HC3                 'C3         ret
    Comparer(19) = &H68                 '68xxxxxxxx push xxxxxxxx
    CopyMemory Comparer(20), VarCmp, 4
    Comparer(24) = &HC3                 'C3         ret
End Sub

Public Sub Terminate()
    FreeLibrary hModule1
    FreeLibrary hModule2
End Sub

Public Sub SystemSort(SortArray())
    Initialize
    CallWindowProc VarPtr(Thunk(0)), VarPtr(SortArray(LBound(SortArray))), UBound(SortArray) - LBound(SortArray) + 1, 16, VarPtr(Comparer(0))
    Terminate
End Sub



Sub Main()
Dim i As Long, MyArr(-800 To 4000), StartTime As Single
 
  Randomize Timer
  For i = LBound(MyArr) To UBound(MyArr)
    MyArr(i) = Rnd * 800
  Next

  StartTime = Timer
  SystemSort MyArr
  Debug.Print Round(Timer - StartTime, 4)

End Sub


vbskb_sort vbskb_qsort vbskb_quicksort

[13GHOST]

Не добившись рабоспособности твоего кода, пришлось самому придумать:

Код: Выделить всё

Sub ShellSort(sort() As String)'сортирует массив sort() в алфавитном порядке
Dim span As Integer, temp As String
Dim i As Integer, j As Integer
span = UBound(sort()) \ 2

Do While span > 0
    For i = span To UBound(sort()) - 1
        j = i - span + 1
        For j = (i - span + 1) To 1 Step -span
            If sort(j) <= sort(j + span) Then Exit For
            temp = sort(j)
            sort(j) = sort(j + span)
            sort(j + span) = temp
        Next j
    Next i
    span = span \ 2
Loop

End Sub


[tyomitch]

Очень интересно, и что же ты с ним такое сделал, что он не работал? Неужели в форму запихнул?

[Ennor]

Хм. Круто, Темыч, ничего не скажешь. Я в свое время тоже подкапывался к этой функции, но меня остановило другое - ей надо передавать указатель на cdecl-функцию, а я в басике такого делать не умею А объявить-то ее можно и как cdecl сразу, прямо в декларе...

[tyomitch]

Объявить как cdecl прямо в декларе - как?
Неужели и вправду можно? Никогда не слышал об этой возможности...

[Ennor]

Теоретически возможность есть, но я ни разу не пробовал - не нашел подходящей функции для проверки :

Код: Выделить всё

Private Declare Sub qsort CDecl Lib "ntdll" (base As Any, ByVal num As Long, ByVal width As Long, ByVal compare As Long)

По крайней мере, слово CDecl в VB является зарезервированным, и встает только в то место, в котором я его написал ...

[mad_Max]

Вряд ли сработает:

Bad DLL calling convention (Error 49)
This error has the following causes and solutions:
...
Your Declare statement includes CDecl.
The CDecl keyword applies only to the Macintosh.

Это из справки VB5. При чем тут только Macintosh...

[Ennor]

Понятно, этого я и боялся...

[tyomitch]

При чем тут только Macintosh...

Как при чём - на тамошнем VBA можно, а на нашем нельзя... Позор

Так что, Ennor, без моего изврата - не удастся ничего...