qsort

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Declare Function Compare Lib "user32" Alias _
"CallWindowProcA" (ByVal pfnCompare As Long, ByVal pElem1 As Long, _
                   ByVal pElem2 As Long, ByVal unused1 As Long, _
                   ByVal unused2 As Long) As Integer
                   
Declare Function VarPtrArray Lib "msvbvm60.dll" _
            Alias "VarPtr" (Var() As Any) As Long
     Private MyArr(2) As student  '要排序的字串数组
    Private lStrPtrs() As Variant  '上面数组的字串指针数组，后面会凭空构造它
Sub e1()
'    Dim MyArr(2) As
    Set MyArr(0) = New student
     Set MyArr(1) = New student
      Set MyArr(2) = New student
    MyArr(0).id = 3
    MyArr(1).id = 2
'Call SwapStrPtr2(VarPtr(arr(0)), VarPtr(arr(1)))
      MyArr(2).id = 1
          Dim pSA As Long        '保存lStrPtrs数组的SafeArray结构指针
    Dim pvDataOld As Long  '保存lStrPtrs数组的SafeArray结构的原
                               '    pvData指针，以便恢复lStrPtrs
         Call SetupStrPtrs(pSA, pvDataOld)
                   '现在来交换第0个和第3个字串
        Dim lTmp As Long
        lTmp = lStrPtrs(2)
        lStrPtrs(2) = lStrPtrs(0)
        lStrPtrs(0) = lTmp
       Call clear(pSA, pvDataOld)
     ' Call qsort(VarPtr(arr(0)), UBound(arr) + 1, 4, arr(0).zb_AddressOf(3, 4))
End Sub

Sub e3()
    Dim arr(2) As Long
    arr(0) = 3
    arr(1) = 2
   Call SwapStrPtr2(VarPtr(arr(0)), VarPtr(arr(1)))
End Sub

Sub e4()
    Dim s As New student
    
End Sub
Sub qsort(ByVal ArrayPtr As Long, ByVal nCount As Long, ByVal nElemSize As Integer, ByVal pfnCompare As Long)
        Dim i As Long, j As Long
        
        For i = 1 To nCount
            For j = i + 1 To nCount
                '这里省略快速排序算法的具体实现，仅给出比较两个元素的方法。
                If Compare(pfnCompare, ArrayPtr + (i - 1) * nElemSize, _
                           ArrayPtr + (j - 1) * nElemSize, 0, 0) > 0 Then
                    '如果第i个元素比第j个元素大则用CopyMemory来交换这两个元素。
                  Call SwapStrPtr2(ArrayPtr + (i - 1) * nElemSize, ArrayPtr + (j - 1) * nElemSize)
                End If
            Next
        Next
    End Sub

 Sub SwapStrPtr3(SA As student, sB As student)
        Dim temp As Object
        CopyMemory temp, ByVal VarPtr(SA), 4
        CopyMemory ByVal VarPtr(SA), ByVal VarPtr(sB), 4
        CopyMemory ByVal VarPtr(sB), temp, 4
End Sub
   Sub SwapStrPtr2(SA As Long, sB As Long)
        Dim lTmp As Variant
        Dim pTmp As Long
        pTmp = VarPtr(lTmp)
        CopyMemory pTmp, ByVal SA, 4
        CopyMemory ByVal SA, ByVal sB, 4
        CopyMemory ByVal sB, pTmp, 4
    End Sub
 Private Sub SetupStrPtrs(ByRef pSA As Long, ByRef pvDataOld As Long)


        Dim pvData As Long
       
        ' 初始化lStrPtrs，不需要将数组设得和MyArr一样大
        '     我们会在后面构造它
        ReDim lStrPtrs(0) As Long
       
       '得到字串数组的pvData
        pvData = VarPtr(MyArr(0))

       '得到lStrPtrs数组的SafeArray结构指针
        CopyMemory pSA, ByVal VarPtrArray(lStrPtrs), 4
       
        '这个指针偏移12个字节后就是pvData指针，将这个指针保存到pvDataOld
        '    以便最后还原lStrPtrs，此处也可以用：
        '        pvDataOld = VarPtr(lStrPtrs(0))
        CopyMemory pvDataOld, ByVal pSA + 12, 4
       
        '将MyArr的pvData写到lStrPtrs的pvData里去
        CopyMemory ByVal pSA + 12, pvData, 4
       
        '完整构造SafeArray必须要构造它的rgsabound(0).cElements
        CopyMemory ByVal pSA + 16, UBound(MyArr) - LBound(MyArr) + 1, 4
        '还有rgsabound(0).lLbound
        CopyMemory ByVal pSA + 20, LBound(MyArr), 4
        
 
        
        
    End Sub

Sub clear(ByRef pSA As Long, ByRef pvDataOld As Long)
        
                'lStrPtr的原来声明为：ReDim lStrPtrs(0) As Long
        '    按声明的要求还原它
        CopyMemory pSA, ByVal VarPtrArray(lStrPtrs), 4
        CopyMemory ByVal pSA + 12, pvDataOld, 4
        CopyMemory ByVal pSA + 16, 1, 4
        CopyMemory ByVal pSA + 20, 0, 4
End Sub

Sub Test111()
End Sub