Rubrik: Variablen/Strings · Arrays | VB-Versionen: VB6 | 07.07.05 |
Sortieren von Arrays aus Strings fester Länge II Schnelles Sortieren von Arrays aus Strings fester Länge | ||
Autor: Manfred Bohn | Bewertung: | Views: 11.250 |
ohne Homepage | System: WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | kein Beispielprojekt |
Im Tipp Sortieren von Arrays aus Strings fester Länge ist gezeigt worden, auf welche Weise man Funktionen erstellen kann, die Arrays aus Strings fester, aber beliebiger Länge bearbeiten können. Weil diese Routinen zum Zweck der Demonstration erstellt worden sind, ist auf die Optimierung der Sortiergeschwindigkeit verzichtet worden.
Das Modul 'Sort_StringF' enthält eine Version, die weniger als die Hälfte der Zeit benötigt:
- die Array-Informationen werden in modulglobalen Variablen gespeichert
- die Zahl der Unterprogramm-Aufrufe ist reduziert
- die Position der Strings wird in einem Long-Array gespeichert
- es werden Byte- statt String-Operationen verwendet
Im Vergleich zu Routinen, die Arrays aus Strings mit einer bestimmten festen Länge sortieren, - die also auf Zeiger-Operationen verzichten können - , benötigt auch die Routine 'Sort_StringF' noch mehr als die doppelte Zeit.
Zum Aufruf: vgl. Tipp: Sortieren von Arrays aus Strings fester Länge
' ================================================================== ' Start Quellcode Modul 'modSort_StringF' ' ================================================================== Option Explicit ' VarPtr-Funktionsaufruf für Arrays Public Declare Function VarPtrArray Lib "msvbvm60.dll" _ Alias "VarPtr" ( _ Ptr() As Any) As Long ' schnelle API-Kopierfunktion für Bytefolgen Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" ( _ Ziel As Any, _ Quelle As Any, _ ByVal Anzahl_Bytes As Long) ' SafeArray-Struktur (eindimensionales Array) Private Type udtArrayInfo Dimensionen As Integer ' Zahl der Dimensionen Features As Integer ' Attribute (Bitfolge) Bytes_pro_Feld As Long ' Anzahl der Bytes pro Element Locks As Long ' Anzahl der gesetzten Array-Sperren Data_Pointer As Long ' bei Strings: Varptr --> Deskriptor Elemente As Long ' Elemente im Array Untergrenze As Long ' Untergrenze der Dimension End Type ' Array-Informationen modulglobal Dim gDaten_Zeiger As Long ' Zeiger auf Startposition des Array Dim gString_Länge As Long ' Byte-Länge der Array-Strings Dim gArray_Elemente As Long ' Zahl der Array-Elemente ' Sortier-Strings als Bytefolgen (modulglobal) Dim gStringByte() As Byte ' für Vergleich und Tausch Dim gKeyByte() As Byte ' Schlüsselstring ' Array mit Zeigern auf String-Positionen Dim gStringPos() As Long ' Überwachung der Rekursionstiefe Dim gRekursionsTiefe As Long
Public Function Sort_StringF(ByVal pArray As Long) ' Sortieren eines Array aus Strings fester Länge ' Übergabe des Zeigers auf das Array erforderlich! ' aufrufen durch: VarPtrArray(StringArray()) Dim SafeArray As udtArrayInfo Dim i As Long, z As Long ' Loop ' SafeArray-Struktur abfragen If Not GetSafeArray(pArray, SafeArray) Then Exit Function ' ArrayInfos in modulglobale Variable With SafeArray gDaten_Zeiger = .Data_Pointer gString_Länge = .Bytes_pro_Feld gArray_Elemente = .Elemente End With ' ByteArrays einrichten ReDim gStringByte(1 To gString_Länge) ReDim gKeyByte(1 To gString_Länge) ' ZeigerArray einrichten und füllen ReDim gStringPos(1 To gArray_Elemente) z = gDaten_Zeiger For i = 1 To gArray_Elemente gStringPos(i) = z z = z + gString_Länge Next i ' Initialisieren gRekursionsTiefe = 0 ' Sortieren Sort_StringF = QuickSort_StringF(1, gArray_Elemente) End Function
Public Function GetSafeArray(ByRef pArray As Long, _ SafeArray As udtArrayInfo) As Boolean ' Safe-Array-Struktur abfragen Dim ptrS As Long, iDim As Long ' Array gegeben If pArray = 0 Then Exit Function ' Adresse des Array-Info-Blocks besorgen Call CopyMemory(ptrS, ByVal pArray, 4&) ' Array dimensioniert? If ptrS = 0 Then Exit Function ' Zahl der Dimensionen des Array besorgen Call CopyMemory(iDim, ByVal ptrS, 2&) If iDim <> 1 Then ' unplausible Anzahl Dimensionen! Exit Function End If ' SafeArray in den Array-Info-Block kopieren Call CopyMemory(SafeArray, ByVal ptrS, CLng(16 + iDim * 8)) With SafeArray GetSafeArray = .Data_Pointer > 0 And _ .Bytes_pro_Feld > 1 And .Elemente > 0 End With End Function
Private Function CompareStringKeyF(ByVal Index As Long) As Long ' String fester Länge an Array-Index 'index' ' mit Keystring (Bytefolge) vergleichen (in 'gKeyByte') Dim Ptr As Long If Index < 1 Or Index > gArray_Elemente Then Exit Function ' String am 'Index' als Bytefolge besorgen Call CopyMemory(gStringByte(1), ByVal gStringPos(Index), gString_Länge) ' String mit Key-String vergleichen CompareStringKeyF = StrComp(gKeyByte(), gStringByte(), vbTextCompare) End Function
Private Function QuickSort_StringF(ByVal lngStart As Long, _ ByVal lngEnd As Long) As Boolean ' rekursiver Quicksort für Array aus Strings fester Länge ' Rekursionstiefen-Überwachung und Zufalls-Schlüssel Dim i As Long, j As Long ' Loop Dim ptri As Long, ptrj As Long ' Zeiger aud Array-Elemente i, j Dim IndKey As Long ' Array-Index Schlüsselstring ' Rekursionstiefe überschritten? If gRekursionsTiefe > 200 Then Exit Function ' neue Rekursion startet gRekursionsTiefe = gRekursionsTiefe + 1 ' zu sortierender Bereich i = lngStart: j = lngEnd ' Zufälliger Schlüssel: modulglobal speichern IndKey = Rnd * (lngEnd - lngStart) + lngStart Call CopyMemory(gKeyByte(1), ByVal gStringPos(IndKey), gString_Länge) ' Array aufteilen Do While CompareStringKeyF(i) > 0 i = i + 1 Wend While CompareStringKeyF(j) < 0 j = j - 1 Wend If (i <= j) Then ' Tauschen j <--> i Call CopyMemory(gStringByte(1), ByVal gStringPos(i), gString_Länge) Call CopyMemory(ByVal gStringPos(i), ByVal gStringPos(j), gString_Länge) Call CopyMemory(ByVal gStringPos(j), gStringByte(1), gString_Länge) i = i + 1: j = j - 1 End If Loop Until (i > j) ' Rekursive Quicksort-Aufrufe If (lngStart < j) Then If Not QuickSort_StringF(lngStart, j) Then Exit Function End If If (i < lngEnd) Then If Not QuickSort_StringF(i, lngEnd) Then Exit Function End If ' Rekursionstiefe am Routinenende verringern gRekursionsTiefe = gRekursionsTiefe - 1 QuickSort_StringF = True End Function ' ================================================================== ' Ende Quellcode Modul 'modSort_StringF' ' ==================================================================