Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0645: Daten mit Quicksort sortieren (ASM)

VB 5/6-Tipp 0645: Daten mit Quicksort sortieren (ASM)

 von PjotrC

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (CopyMemory), VirtualAlloc, VirtualFree, CallWindowProcA (cdByVal), RtlMoveMemory (memCPY)

Download: Download des Beispielprojektes [16.31 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kombinationsliste "Combo2"
' Steuerelement: Kontrollkästchen-Steuerelement "Check2"
' Steuerelement: Kontrollkästchen-Steuerelement "Check1"
' Steuerelement: Kombinationsliste "Combo1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Listen-Steuerelement "List2"
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"



'-------------------------------------------------------------
' Dieses Formular zeigt, wie die Assembler-Routine arrSRT
' eingesetzt wird, um mittels ASM ziemlich schnell Arrays zu
' sortieren. Der ASM-Quellcode kann in der Datei arrSRT.ASM
' eingesehen und ggf. den Bedürfnissen angepaßt werden. Der
' Originalcode stammt von Daniel Aue und ist im ActiveVB-
' Upload verfügbar. Änderungen sind im Header der Datei
' arrSRT gelistet.
'
' Auf den ActiveVB-Seiten können eine Reihe Sortierroutinen
' eingesehen werden, die reinen VB-Code nutzen. Deshalb wurde
' hier auf eine "Übersetzung" der ASM-Routine verzichtet.
'
'-------------------------------------------------------------
' Ein Formular mit: Label1, List1, Check1, Combo1, Text1,
'                   Label2, List2, Check2, Combo2, Command1
'                   Label3
'-------------------------------------------------------------

Option Explicit

Private Const C2T As Long = 567 ' cm to twips

Private arrB() As Byte      ' arrays verschiedenen
Private arrI() As Integer   ' Typs für die
Private arrL() As Long      ' Sortiertests
Private arrX() As Double
Private arrD() As Date
Private arrC() As Currency
Private arrS() As String
Private arrR() As Variant   ' Referenz-Array

Private cur(1) As Currency  ' Zeitmessung
Private ini    As Boolean   ' Initialisierungsflag

' API-Kopierfunktion
Private Declare Sub memCPY _
    Lib "kernel32" Alias "RtlMoveMemory" _
   (ByRef hpvDest As Any, _
    ByRef hpvSource As Any, _
    ByVal cbCopy As Long)

' Formular mit Vorgaben füllen
Private Sub Form_Load()
    Me.Caption = "Arrays sortieren mit ASM"
    Label1.Caption = "Datentyp"
    Label2.Caption = "Elemente"
    Text1.Text = "1000"
    Check1.Caption = "absteigend"
    Check2.Caption = "vorzeichenlos"
    Command1.Caption = "Sort"
    List1.Font = "Courier new"
    List2.Font = "Courier new"
    
    With Combo1
        .AddItem "Byte"
        .AddItem "Integer"
        .AddItem "Long"
        .AddItem "Double"
        .AddItem "Date"
        .AddItem "Currency"
        .AddItem "String"
        
        .ListIndex = 2
    End With
    
    With Combo2
        .AddItem "Standard"
        .AddItem "Lexikon"
        .AddItem "ASCII"
        
        .ListIndex = 0
    End With

    ini = True
End Sub

' absteigend
Private Sub Check1_Click()
    Command1_Click
End Sub

' vorzeichenlos
Private Sub Check2_Click()
    Command1_Click
End Sub

' Auswahl der zu sortierenden Datentypen
Private Sub Combo1_Click()
    Dim N1 As Long
    
    ' Anzahl beschränken
    N1 = Val(Text1)
    If N1 < 1 Or N1 > 2000000 Then
        MsgBox "Ungültige Elementzahl"
        
    Else
        
        ' Ein entsprechendes Array vorbereiten
        Select Case Combo1.ListIndex
        Case 0: MyRedim arrB, N1, 0, 255
        Case 1: MyRedim arrI, N1, -32768, 65535
        Case 2: MyRedim arrL, N1, -2147483648#, 4294967295#
        Case 3: MyRedim arrX, N1, -2147483648#, 4294967295#
        Case 4: MyRedim arrD, N1, #1/1/1980#, 372183
        Case 5: MyRedim arrC, N1, -2147483648#, 429496729500000#
        Case 6: MyRedim arrS, N1, 0, 0
        End Select
    End If
End Sub

' Sortiermethode auswählen
Private Sub Combo2_Click()
    Command1_Click
End Sub

' Sortieren
Private Sub Command1_Click()
    Dim flg As Long
    
    ' Werte eingegeben?
    If ini Then
        
        'Flags erstellen
        flg = srtReferenceArr Or _
              IIf(Check1.Value, srtDescending, 0) Or _
              IIf(Check2.Value, srtUnsigned, 0) Or _
              (Combo2.ListIndex * 8)
        
        ' Sortierfunktion aufrufen
        Select Case Combo1.ListIndex
        Case 0: MySort arrB, flg, VarPtr(arrB(0)), 1
        Case 1: MySort arrI, flg, VarPtr(arrI(0)), 2
        Case 2: MySort arrL, flg, VarPtr(arrL(0)), 4
        Case 3: MySort arrX, flg, VarPtr(arrX(0)), 8
        Case 4: MySort arrD, flg, VarPtr(arrD(0)), 8
        Case 5: MySort arrC, flg, VarPtr(arrC(0)), 8
        Case 6: MySort arrS, flg, VarPtr(arrS(0)), 4
        End Select
    End If
End Sub

' Formulargröße ändert sich
Private Sub Form_Resize()
    Dim X1      As Double   ' X-Position
    Dim Y1      As Double   ' Y-Position
    Dim W1      As Double   ' Breite
    Dim D1      As Double   ' Abstand
    Dim FW      As Double   ' Breiten-Faktor
    Dim I1      As Long     ' Zähler
    Dim A1()    As String   ' Steuerelement-Namen
    
    On Error Resume Next
    
    ' Größen speichern
    I1 = Me.Width - Me.ScaleWidth + 11.6 * C2T
    If Me.Width < I1 Then Me.Width = I1
    FW = Me.Width / I1
    
    I1 = Me.Height - Me.ScaleHeight _
       + (3 * 0.75 + 0.5 + 4.25) * C2T
    If Me.Height < I1 Then Me.Height = I1
    
    ' Steuerelemente und Angaben zerlegen
    A1 = Split("1.5;0;Label1;Label2;;" & _
               "2.5;.8;Combo1;Text1;;" & _
               "2.5;.8;Combo2;Check1;Check2;" & _
               "3;0;Command1;Label3;", ";")
    
    ' Position oben Links festlegen
    X1 = 0.25 * C2T
    Y1 = 2.5 * C2T
    
    ' Für jedes Element
    For I1 = 0 To UBound(A1)
        
        ' Nach jedem 5. Element neue Position speichern
        If (I1 Mod 5) = 0 Then
            X1 = X1 + W1 + D1
            Y1 = Y1 - 2.25 * C2T
            W1 = Val(A1(I1)) * C2T * FW
            D1 = Val(A1(I1 + 1)) * C2T * FW
            I1 = I1 + 2
        End If
        
        ' Sollte noch ein Control existieren,
        ' dieses unter dem letzen ausrichten
        If Len(A1(I1)) > 0 Then
            With Me.Controls(A1(I1))
                .Top = Y1
                .Left = X1
                .Width = W1
                .Height = 0.5 * C2T
            End With
        End If
        
        ' Jetzt eine Zeile tiefer gehen
        Y1 = Y1 + 0.75 * C2T
    Next
    
    ' 1. Liste ausrichten
    With List1
        .Top = Check2.Top + 1 * C2T
        .Left = 0.25 * C2T
        .Width = (ScaleWidth - C2T) / 2
        .Height = (ScaleHeight - .Top)
    End With
    
    ' 2. Liste ausrichten
    With List2
        .Top = List1.Top
        .Left = 0.75 * C2T + List1.Width
        .Width = List1.Width
        .Height = List1.Height
    End With
End Sub

' Neue Anzahl Elemente -> Liste Füllen
Private Sub Text1_Change()
    If Val(Text1.Text) Then Combo1_Click
End Sub

' Ein Array ausgeben
Function Display(arr, md As Boolean)
    Dim C1 As ListBox
    Dim I1 As Long
    Dim J1 As Long
    Dim J2 As Long
    Dim J3 As Long
    Dim N1 As Long
    
    ' Obergrenze
    N1 = UBound(arr)
    
    ' Obergrenze festlegen
    ' Wenn mehr als 50 Elemente vorhanden sind,
    ' Nur die ersten 25 nehmen und die Anzahl
    ' anderswo speichern
    J1 = N1
    If J1 > 49 Then J1 = 24: J2 = N1
    
    J3 = 0
    
    ' Benötigte Listen leeren
    If md Then Set C1 = List2 Else Set C1 = List1
    C1.Clear: If Not md Then List2.Clear
    
    Do
        ' Alle/25 Werte ausgeben
        For I1 = J3 To J1
            C1.AddItem Format(arrR(I1), "(000000) ") & arr(I1)
        Next
        
        ' Sollte es mehr als 25 Werte geben -> Seperator einfügen
        If J2 Then C1.AddItem "..."
        
        J3 = N1 - 24
        J1 = J2
        J2 = 0
    Loop Until J1 = 0
End Function

' Array redimensionieren und mit Werten Füllen
Function MyRedim(arr As Variant, cnt As Variant, _
    min As Variant, max As Variant)
    
    Dim T1 As String
    Dim T2 As String
    Dim I1 As Long
    Dim J1 As Long
    
    ' Hier werden Arrays mit dummy-Werten versehen
    ReDim arr(cnt - 1)
    ReDim arrR(cnt - 1)
    
    Randomize Timer
    
    ' Soll ein String zurückgegeben werden?
    If (VarType(arr) And 15) = vbString Then
        
        ' Zeichenvorrat festlegen
        T1 = "0123456789" _
           & "ABCDEFGHIJKLMNOPQRSTUVWXYZ" _
           & "abcdefghijklmnopqrstuvwxyz"
        
        ' Jedes Element durchlaufen
        For I1 = 0 To cnt - 1
            arrR(I1) = I1
            T2 = Space(Rnd() * 20)
            
            ' Jedes Element mit 20 Zufallszahlen füllen
            For J1 = 1 To Len(T2)
                Mid$(T2, J1, 1) = Mid$(T1, 1 + Fix(Rnd() * 62))
            Next J1
            arr(I1) = T2
        Next I1
            
        ' Kein String
    Else
        
        ' Jedes Element mit Zahlen im vorgegebenen Rahmen füllen
        For I1 = 0 To cnt - 1
            arrR(I1) = I1
            arr(I1) = min + Fix(Rnd() * max)
        Next
    End If
    
    ' Neues Array anzeigen
    Display arr, False
End Function

Function MySort(arr, flg As Long, ptr As Long, cnt As Long)
    Dim N1      As Long
    Dim bar()   As Byte
    
    ' Um die Anzeige bei mehrfacher Sortierung gleich zu
    ' behalten, den ursprünglichen Arrayinhalt sichern
    If UBound(arr) Then
        N1 = cnt * (UBound(arr) + 1)
        ReDim bar(N1 - 1)
        memCPY bar(0), ByVal ptr, N1
    End If
    
    ' hier wird die Sortierroutine aufgerufen
    arrSRT arr, arrR, flg
    Display arr, True
    
    ' gesicherte Arraywerte zurückschreiben
    If N1 Then memCPY ByVal ptr, bar(0), N1
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------


'--------------------------------------------------------------
' Sortiert ein Array mithilfe einer Assembler-Routine
'--------------------------------------------------------------
'
' Original von  :  Daniel Aue 03.09.2003
' Revised  von  :  (softKUS) - III/2004
'--------------------------------------------------------------

Option Explicit
Option Compare Text

Public Enum srtModes
    srtDescending = 1
    srtUnsigned = 2
    srtReferenceArr = 4
    srtStandard = 0
    srtLexical = 8
    srtAscii = 16
    srtUserDefChrMap = 24
End Enum
    
Public Declare Function cdByVal _
    Lib "user32" Alias "CallWindowProcA" _
   (ByVal asm As Long, _
    ByVal PA1 As Long, _
    ByVal PA2 As Long, _
    ByVal PA3 As Long, _
    ByVal PA4 As Long) As Long


'VirtualAlloc-API, um Speicheradresse für ausführbaren Code zu erhalten (wegen NX-Bit-Funktionalität)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VirtualAlloc Lib "kernel32.dll" (ByRef lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32.dll" (ByRef lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Const MEM_COMMIT                As Long = &H1000&
Private Const MEM_RELEASE               As Long = &H8000&
Private Const PAGE_EXECUTE_READWRITE    As Long = &H40&


' arrSRT        Sortiert ein Array
'
' CALL:         arrSRT(arr, [@ref], [flg], [tbl])
'
' IN:           var:arr Array, das sortiert werden soll
'
'               var:@ref Referenzarray, welches dir original
'                        Referenzpositionen im Array speichern
'
'               lng:flg Flags
'                       bit   0: 0=aufsteigend  (Vorgabe)
'                                1=absteigend
'
'                                Nur numerisch
'                       bit   1: 0=Vorzeichen beachten (Vorgabe)
'                                1=Ohne Vorzeichen sortieren
'
'                                Nur bei Texten
'                       bit 2/3: 00=standard
'                                01=lexikalisch
'                                10=ascii
'                                11=benutzerdefiniert
'
'               lng:tbl Pointer auf eine Benutzerdefinierte
'                       Zeichentabelle
'                       (Nur bei Strings)
'
' OUT:          lng      0: okay
'                       -1: Ungültige Dimension (UBound = -1)
'                       -2: Nicht unterstützter Datentyp varType
'                       -3: Kein Datapointer (sollte nicht passieren)
'                       -4: Ungültige Dimention (<> 1)
'                       -5: Keine Dimension (keine SAR-Struktur vorhanden)
'                       -6: Kein Array
'                       -7: Fehlende Sortiertabelle
'                           (ungültige Flags)
'
Function arrSRT( _
    arr As Variant, _
    Optional ref As Variant, _
    Optional flg As srtModes = srtStandard, _
    Optional tbl As Long) As Long
        
    Static asc(63)  As Long
    Static std(63)  As Long
    Static lex(63)  As Long
    Static asmCode(206) As Long
    Static asmAddr As Long
    Static asmLength As Integer


    If asmCode(0) = 0 Then

        asmCode(0) = &HEC8B5590:  asmCode(1) = &HE8575653:  asmCode(2) = &H0
        asmCode(3) = &H758BFA6A:  asmCode(4) = &H6B70F08:   asmCode(5) = &HF20C4F6
        asmCode(6) = &HB184&:     asmCode(7) = &HEC45FF00:  asmCode(8) = &HF608768B
        asmCode(9) = &H27440C4:   asmCode(10) = &HF60B368B: asmCode(11) = &H9C840F
        asmCode(12) = &H45FF0000: asmCode(13) = &H3E8366EC: asmCode(14) = &H8F850F01
        asmCode(15) = &HFF000000: asmCode(16) = &H7E8BEC45: asmCode(17) = &HFFF0B0C
        asmCode(18) = &H8184&:    asmCode(19) = &HEC45FF00: asmCode(20) = &H7A73123C
        asmCode(21) = &HCFBB&:    asmCode(22) = &HF05D0300: asmCode(23) = &H74C00AD7
        asmCode(24) = &HEC45FF6D: asmCode(25) = &H3C20538D: asmCode(26) = &HF70F7305
        asmCode(27) = &H21445:    asmCode(28) = &H6740000:  asmCode(29) = &H4C281
        asmCode(30) = &HE4320000: asmCode(31) = &H43448B66: asmCode(32) = &H53D80310
        asmCode(33) = &H49104E8B: asmCode(34) = &H45FF4478: asmCode(35) = &H513FE3EC
        asmCode(36) = &H314468B:  asmCode(37) = &HC758BC1:  asmCode(38) = &H5EBF60B
        asmCode(39) = &H488E0489: asmCode(40) = &H8BF97549: asmCode(41) = &H144D8BF3
        asmCode(42) = &H3301E180: asmCode(43) = &H38A4BC0:  asmCode(44) = &HE74C00B
        asmCode(45) = &H4B4BF003: asmCode(46) = &H8AD7C18A: asmCode(47) = &H6881004
        asmCode(48) = &HC033EBEB: asmCode(49) = &H50E4558B: asmCode(50) = &H25EE852
        asmCode(51) = &H458B0000: asmCode(52) = &HF4658DEC: asmCode(53) = &H5D5B5E5F
        asmCode(54) = &H10C2:     asmCode(55) = &H5030200:  asmCode(56) = &H7060406
        asmCode(57) = &H30000:    asmCode(58) = &H0:        asmCode(59) = &H5B002F01
        asmCode(60) = &HB2008D00: asmCode(61) = &H1E00E500: asmCode(62) = &H7C017D01
        asmCode(63) = &H7277727F: asmCode(64) = &H777277:   asmCode(65) = &H1070100
        asmCode(66) = &H1C8A0800: asmCode(67) = &H3A404839: asmCode(68) = &HFA7F381C
        asmCode(69) = &H1C3A4A42: asmCode(70) = &H3BFA7C3A: asmCode(71) = &H8A097DC2
        asmCode(72) = &HC86380C:  asmCode(73) = &H380C883A: asmCode(74) = &H1BEE8
        asmCode(75) = &HE0EB00:   asmCode(76) = &H1080100:  asmCode(77) = &H8B660A00
        asmCode(78) = &H40484F1C: asmCode(79) = &H471C3B66: asmCode(80) = &H4A42F97F
        asmCode(81) = &H571C3B66: asmCode(82) = &HC23BF97C: asmCode(83) = &H8B660C73
        asmCode(84) = &H8766470C: asmCode(85) = &H8966570C: asmCode(86) = &H8CE8470C
        asmCode(87) = &HEB000001: asmCode(88) = &H10000DB:  asmCode(89) = &H8000107
        asmCode(90) = &H488F1C8B: asmCode(91) = &H871C3B40: asmCode(92) = &H4A42FA7F
        asmCode(93) = &H7C971C3B: asmCode(94) = &H160E8FA:  asmCode(95) = &HEDEB0000
        asmCode(96) = &H7030200:  asmCode(97) = &H3080100:  asmCode(98) = &H10702
        asmCode(99) = &HCF748B0D: asmCode(100) = &HCF1C8B04: asmCode(101) = &H743B4048
        asmCode(102) = &HF97F04C7: asmCode(103) = &H1C3B0775: asmCode(104) = &H42F277C7
        asmCode(105) = &HD7743B4A: asmCode(106) = &H75F97C04: asmCode(107) = &HD71C3B05
        asmCode(108) = &HCE8F272:  asmCode(109) = &HEB000001: asmCode(110) = &H10000DD
        asmCode(111) = &H12000111: asmCode(112) = &H488F1C8B: asmCode(113) = &H8BF38B40
        asmCode(114) = &HF185870C: asmCode(115) = &HF1870279: asmCode(116) = &HF07FF13B
        asmCode(117) = &HF38B4A42: asmCode(118) = &H85970C8B: asmCode(119) = &H870279F1
        asmCode(120) = &H7CF13BF1: asmCode(121) = &HF4E8F0:   asmCode(122) = &HD9EB0000
        asmCode(123) = &H8030200:  asmCode(124) = &H31A0100:  asmCode(125) = &H10802
        asmCode(126) = &HCF1C8B25: asmCode(127) = &H4CF748B:  asmCode(128) = &H89DC5D89
        asmCode(129) = &H4048E075: asmCode(130) = &H8DDC758D: asmCode(131) = &H4E8BC71C
        asmCode(132) = &H44B8504:  asmCode(133) = &HF3870279: asmCode(134) = &H3B044E8B
        asmCode(135) = &HE77F044B: asmCode(136) = &HE8B0875:  asmCode(137) = &HDF770B3B
        asmCode(138) = &H758D4A42: asmCode(139) = &HD71C8DDC: asmCode(140) = &H85044B8B
        asmCode(141) = &H279044E:  asmCode(142) = &H4E8BF387: asmCode(143) = &H44B3B04
        asmCode(144) = &H675E77C:  asmCode(145) = &HB3B0E8B:  asmCode(146) = &H74E8DF72
        asmCode(147) = &HEB000000: asmCode(148) = &H30200B7:  asmCode(149) = &H1C02030B
        asmCode(150) = &H8B105D8B: asmCode(151) = &H75898F34: asmCode(152) = &H74F60BE0
        asmCode(153) = &HFC768B03: asmCode(154) = &H48DC7589: asmCode(155) = &HE8C88B40
        asmCode(156) = &H14:       asmCode(157) = &H4A42F677: asmCode(158) = &H9E8CA8B
        asmCode(159) = &H72000000: asmCode(160) = &H58E8F6:   asmCode(161) = &HE5EB0000
        asmCode(162) = &H8B505257: asmCode(163) = &H3C8BE075: asmCode(164) = &HE3CF8B8F
        asmCode(165) = &HFC4F8B03: asmCode(166) = &H9CDC4D39: asmCode(167) = &H4D8B0373
        asmCode(168) = &H74E9D1DC: asmCode(169) = &H8BC03317: asmCode(170) = &H8A068AD0
        asmCode(171) = &H18048A17: asmCode(172) = &H47474646: asmCode(173) = &H751A043A
        asmCode(174) = &HED754905: asmCode(175) = &H5858509D: asmCode(176) = &H3BC35F5A
        asmCode(177) = &H8B247DC2: asmCode(178) = &H8704C74C: asmCode(179) = &H8904D74C
        asmCode(180) = &H8B04C74C: asmCode(181) = &HC87C70C:  asmCode(182) = &HC70C89D7
        asmCode(183) = &HC23B0DEB: asmCode(184) = &HC8B097D:  asmCode(185) = &H970C8787
        asmCode(186) = &H74870C89: asmCode(187) = &H831B7F16: asmCode(188) = &H74000C7D
        asmCode(189) = &H5D8B530E: asmCode(190) = &H830C8B0C: asmCode(191) = &H89930C87
        asmCode(192) = &H405B830C: asmCode(193) = &H7FC23B4A: asmCode(194) = &H543BC301
        asmCode(195) = &H97E0C24:  asmCode(196) = &HC24448B:  asmCode(197) = &H13E8
        asmCode(198) = &H24443B00: asmCode(199) = &H8B097D08: asmCode(200) = &HE8082454
        asmCode(201) = &H4:        asmCode(202) = &H8C259:    asmCode(203) = &H51525059
        asmCode(204) = &H8DE875FF: asmCode(205) = &HE9D1020C: asmCode(206) = &HC3

        ' ascii-table
        asc(0) = &H3020100:   asc(1) = &H7060504:   asc(2) = &HB0A0908
        asc(3) = &HF0E0D0C:   asc(4) = &H13121110:  asc(5) = &H17161514
        asc(6) = &H1B1A1918:  asc(7) = &H1F1E1D1C:  asc(8) = &H23222120
        asc(9) = &H27262524:  asc(10) = &H2B2A2928: asc(11) = &H2F2E2D2C
        asc(12) = &H33323130: asc(13) = &H37363534: asc(14) = &H3B3A3938
        asc(15) = &H3F3E3D3C: asc(16) = &H43424140: asc(17) = &H47464544
        asc(18) = &H4B4A4948: asc(19) = &H4F4E4D4C: asc(20) = &H53525150
        asc(21) = &H57565554: asc(22) = &H5B5A5958: asc(23) = &H5F5E5D5C
        asc(24) = &H63626160: asc(25) = &H67666564: asc(26) = &H6B6A6968
        asc(27) = &H6F6E6D6C: asc(28) = &H73727170: asc(29) = &H77767574
        asc(30) = &H7B7A7978: asc(31) = &H7F7E7D7C: asc(32) = &H83828180
        asc(33) = &H87868584: asc(34) = &H8B8A8988: asc(35) = &H8F8E8D8C
        asc(36) = &H93929190: asc(37) = &H97969594: asc(38) = &H9B9A9998
        asc(39) = &H9F9E9D9C: asc(40) = &HA3A2A1A0: asc(41) = &HA7A6A5A4
        asc(42) = &HABAAA9A8: asc(43) = &HAFAEADAC: asc(44) = &HB3B2B1B0
        asc(45) = &HB7B6B5B4: asc(46) = &HBBBAB9B8: asc(47) = &HBFBEBDBC
        asc(48) = &HC3C2C1C0: asc(49) = &HC7C6C5C4: asc(50) = &HCBCAC9C8
        asc(51) = &HCFCECDCC: asc(52) = &HD3D2D1D0: asc(53) = &HD7D6D5D4
        asc(54) = &HDBDAD9D8: asc(55) = &HDFDEDDDC: asc(56) = &HE3E2E1E0
        asc(57) = &HE7E6E5E4: asc(58) = &HEBEAE9E8: asc(59) = &HEFEEEDEC
        asc(60) = &HF3F2F1F0: asc(61) = &HF7F6F5F4: asc(62) = &HFBFAF9F8
        asc(63) = &HFFFEFDFC
       
        ' standard table
        std(0) = &H2010000:   std(1) = &H6050403:   std(2) = &H29282707
        std(3) = &H9082B2A:   std(4) = &HD0C0B0A:   std(5) = &H11100F0E
        std(6) = &H15141312:  std(7) = &H19181716:  std(8) = &H2E2D2C25
        std(9) = &H2031302F:  std(10) = &H57343332: std(11) = &H37362135
        std(12) = &H7B797772: std(13) = &H7F7E7D7C: std(14) = &H39388180
        std(15) = &H3A5A5958: std(16) = &H9694833B: std(17) = &HABA89E9A
        std(18) = &HBBB9AFAD: std(19) = &HC5C1BFBD: std(20) = &HDCDAD8D6
        std(21) = &HF2F0E6E1: std(22) = &H3CFCF6F4: std(23) = &H413F3E3D
        std(24) = &H96948342: std(25) = &HABA89E9A: std(26) = &HBBB9AFAD
        std(27) = &HC5C1BFBD: std(28) = &HDCDAD8D6: std(29) = &HF2F0E6E1
        std(30) = &H43FCF6F4: std(31) = &H1A464544: std(32) = &HA9511B71
        std(33) = &H6D6C6F54: std(34) = &H55DE7040: std(35) = &H1DFE1CD4
        std(36) = &H52504F1E: std(37) = &H24236E53: std(38) = &H56DEE44E
        std(39) = &HFAFE1FD4: std(40) = &H61604726: std(41) = &H64486362
        std(42) = &H5C846549: std(43) = &H4A672266: std(44) = &H7B795B68
        std(45) = &H6B6A694B: std(46) = &H5DC6774C: std(47) = &H4D757473
        std(48) = &H8E8A8688: std(49) = &H98929083: std(50) = &HA6A4A0A2
        std(51) = &HB7B5B1B3: std(52) = &HC8CAC39C: std(53) = &H5EC5D0CC
        std(54) = &HECE8EAD2: std(55) = &HDCE3F8E6: std(56) = &H8E8A8688
        std(57) = &H98929083: std(58) = &HA6A4A0A2: std(59) = &HB7B5B1B3
        std(60) = &HC8CAC39C: std(61) = &H5FC5D0CC: std(62) = &HECE8EAD2
        std(63) = &HFAE3F8E6
        
        ' lexical table
        lex(0) = &H2010000:   lex(1) = &H6050403:   lex(2) = &H29282707
        lex(3) = &H9082B2A:   lex(4) = &HD0C0B0A:   lex(5) = &H11100F0E
        lex(6) = &H15141312:  lex(7) = &H19181716:  lex(8) = &H2E2D2C25
        lex(9) = &H2031302F:  lex(10) = &H57343332: lex(11) = &H37362135
        lex(12) = &H7A787672: lex(13) = &H7F7E7D7C: lex(14) = &H39388180
        lex(15) = &H3A5A5958: lex(16) = &H9593823B: lex(17) = &HAAA79D99
        lex(18) = &HBAB8AEAC: lex(19) = &HC4C0BEBC: lex(20) = &HDBD9D7D5
        lex(21) = &HF1EFE5E0: lex(22) = &H3CFBF5F3: lex(23) = &H413F3E3D
        lex(24) = &H96948342: lex(25) = &HABA89E9A: lex(26) = &HBBB9AFAD
        lex(27) = &HC5C1BFBD: lex(28) = &HDCDAD8D6: lex(29) = &HF2F0E6E1
        lex(30) = &H43FCF6F4: lex(31) = &H1A464544: lex(32) = &HA9511B71
        lex(33) = &H6D6C6F54: lex(34) = &H55DD7040: lex(35) = &H1DFD1CD3
        lex(36) = &H52504F1E: lex(37) = &H24236E53: lex(38) = &H56DEE44E
        lex(39) = &HF9FE1FD4: lex(40) = &H61604726: lex(41) = &H64486362
        lex(42) = &H5C846549: lex(43) = &H4A672266: lex(44) = &H7B795B68
        lex(45) = &H6B6A694B: lex(46) = &H5DC6774C: lex(47) = &H4D757473
        lex(48) = &H8D898587: lex(49) = &H97918F8B: lex(50) = &HA5A39FA1
        lex(51) = &HB6B4B0B2: lex(52) = &HC7C9C29B: lex(53) = &H5ECDCFCB
        lex(54) = &HEBE7E9D1: lex(55) = &HDFE2F7ED: lex(56) = &H8E8A8688
        lex(57) = &H9892908C: lex(58) = &HA6A4A0A2: lex(59) = &HB7B5B1B3
        lex(60) = &HC8CAC39C: lex(61) = &H5FCED0CC: lex(62) = &HECE8EAD2
        lex(63) = &HFAE3F8EE


        ' Allozieren des Speichers für ausführbaren Code
        asmLength = UBound(asmCode) + 1
        asmAddr = VirtualAlloc(ByVal 0, 4 * asmLength, MEM_COMMIT, PAGE_EXECUTE_READWRITE)

        ' Kopieren des kompilierten ASM-Codes, den wir hexadezimal
        ' kodiert in asmMain vorliegen haben, in den ausführbaren Speicher
        ' Funktionsweise des ASM-Codes siehe bsp.-hafte Übersetzung oben
        Call CopyMemory(ByVal asmAddr, asmCode(0), asmLength * 4)

    End If
    
    ' ******************************************************************
    
    Dim pTBL    As Long
    Dim pREF    As Long
    Dim tmp()   As Long
    Dim cnt     As Long
    
    On Error Resume Next
    
    Select Case flg And (srtLexical Or srtAscii)
        Case 0:                 pTBL = VarPtr(std(0))
        Case srtLexical:        pTBL = VarPtr(lex(0))
        Case srtAscii:          pTBL = VarPtr(asc(0))
        Case srtUserDefChrMap:  pTBL = tbl
    End Select
    
    cnt = UBound(arr) - LBound(arr) + 1
    
    If pTBL = 0 Then
        arrSRT = -7
    
    ElseIf cnt = 0 Then
        arrSRT = -6
        
    Else
        If (flg And srtReferenceArr) Then
            ReDim tmp(LBound(arr) To UBound(arr))
            pREF = VarPtr(tmp(LBound(tmp)))
        End If
        
        arrSRT = cdByVal( _
            asmAddr, _
            VarPtr(arr), _
            pREF, _
            pTBL, _
            flg And (srtDescending Or srtUnsigned))
        
        If (flg And srtReferenceArr) Then ref = tmp
    End If
End Function

'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 4 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.