Sortieren von Arrays aus Strings fester Länge II Schnelles Sortieren von Arrays aus Strings fester Länge
Autor:   Manfred Bohn	Bewertung:     [ Jetzt bewerten ]	Views:  11.247
ohne Homepage	System:  WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	kein Beispielprojekt

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 3 Bewertung insgesamt: nützlich Durchschnittliche Bewertung: 3.3 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

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'
' ==================================================================