vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 3.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2021
 
zurück
Rubrik: Variablen/Strings · Arrays   |   VB-Versionen: VB607.07.05
Sortieren von Arrays aus Strings fester Länge II

Schnelles Sortieren von Arrays aus Strings fester Länge

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  10.400 
ohne HomepageSystem:  WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10kein 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'
' ==================================================================

Dieser Tipp wurde bereits 10.400 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2021 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel